PDA

View Full Version : Excel sheet focus problem



abesimpson
04-09-2008, 10:49 AM
I am trying to select a range of data without change the sheet focus. I have included "Application.ScreenUpdating = False" but I suspect that the statement following "Sheets("Portfolio").Select" take over and grabs focus to the Portfolio sheet.

What I want to do is set the RangeOne and RangeTwo value in the Portfolio sheet without changing the focus to the Portfolio sheet.

My code follows:
Sub MakeXML() ' create an XML file from an Excel table

Application.ScreenUpdating = False

Sheets("Portfolio").Select

Dim MyRow As Integer, MyCol As Integer, Temp As String, DefFolder As String
Dim XMLFileName As String, XMLRecSetName As String, RTC1 As Integer
Dim RangeOne As String, RangeTwo As String, Tt As String, FldName(99) As String

DefFolder = "D:\Web Sync\" 'File Location

XMLFileName = "XMLFileName.xml" 'File Name

XMLRecSetName = "record"

RangeOne = "G7:L7" 'Field Names

MyRow = MyRng(RangeOne, 1)
For MyCol = MyRng(RangeOne, 3) To MyRng(RangeOne, 4)
FldName(MyCol - MyRng(RangeOne, 3)) = FillSpaces(Cells(MyRow, MyCol).value)
Next MyCol

RangeTwo = "G8:L100" 'Data Range

RTC1 = MyRng(RangeTwo, 3)

XMLFileName = DefFolder & XMLFileName

Open XMLFileName For Output As #1
Print #1, "<?xml version=" & Chr(34) & "1.0" & Chr(34) & " encoding=" & Chr(34) & "ISO-8859-1" & Chr(34) & "?>"
Print #1, "<hip2b2>"

For MyRow = MyRng(RangeTwo, 1) To MyRng(RangeTwo, 2)
Print #1, "<" & XMLRecSetName & ">"
For MyCol = RTC1 To MyRng(RangeTwo, 4)
' the next line uses the FormChk function to format dates and numbers
Print #1, "<" & FldName(MyCol - RTC1) & ">" & RemoveAmpersands(FormChk(MyRow, MyCol)) & "</" & FldName(MyCol - RTC1) & ">"
Next MyCol
Print #1, "</" & XMLRecSetName & ">"

Next MyRow
Print #1, "</hip2b2>"
Close #1

End Sub

tstav
04-09-2008, 11:15 AM
I am trying to select a range of data
Where exactly (what code line) are you trying to do that?

What does MyRng do? Where is the code?

What does FillSpaces do? Where is the code?

Do you get an error message anywhere? What is it? (Full message, number, description).

Edit:
Also:

What I want to do is set the RangeOne and RangeTwo value
RangeOne and RangeTwo are declared as string variables and are perfectly 'set' on a separate code line each.

You can comment out the Sheets("Portfolio").Select

and add "Sheets("Portfolio")." to the
FillSpaces(Sheets("Portfolio").Cells(MyRow, MyCol).value)


P.S. I can see at least three members looking at your post. Help them help you.

abesimpson
04-09-2008, 02:15 PM
The rest of the Macro is as Follows:
Function MyRng(MyRangeAsText As String, MyItem As Integer) As Integer
' analyse a range, where MyItem represents 1=TR, 2=BR, 3=LHC, 4=RHC

Dim UserRange As Range
Set UserRange = Range(MyRangeAsText)
Select Case MyItem
Case 1
MyRng = UserRange.Row
Case 2
MyRng = UserRange.Row + UserRange.Rows.Count - 1
Case 3
MyRng = UserRange.Column
Case 4
MyRng = UserRange.Columns(UserRange.Columns.Count).Column
End Select
Exit Function

End Function

Function FillSpaces(AnyStr As String) As String
' remove any spaces and replace with underscore character
Dim MyPos As Integer
MyPos = InStr(1, AnyStr, " ")
Do While MyPos > 0
Mid(AnyStr, MyPos, 1) = "_"
MyPos = InStr(1, AnyStr, " ")
Loop
FillSpaces = LCase(AnyStr)
End Function

Function FormChk(RowNum As Integer, ColNum As Integer) As String
' formats numeric and date cell values to comma 000's and DD MMM YY
FormChk = Cells(RowNum, ColNum).Value
If IsNumeric(Cells(RowNum, ColNum).Value) Then
FormChk = Format(Cells(RowNum, ColNum).Value, "#,##.####0;(#,##.####0)")
End If
If IsDate(Cells(RowNum, ColNum).Value) Then
FormChk = Format(Cells(RowNum, ColNum).Value, "dd mmm yy")
End If
End Function

Function RemoveAmpersands(AnyStr As String) As String
Dim MyPos As Integer
' replace Ampersands (&) with plus symbols (+)

MyPos = InStr(1, AnyStr, "&")
Do While MyPos > 0
Mid(AnyStr, MyPos, 1) = "+"
MyPos = InStr(1, AnyStr, "&")
Loop
RemoveAmpersands = AnyStr
End Function

This macro came from an example published in this forum. I modified it to hard code the data range that is to be exported.

This macro runs in a multi-sheet workbook to export the range defined in RangeOne and RangeTwo in XML format.

It is impracticle if every time MakeXML runs the focus changes to the "Portfolio" sheet.

Many thanks

k

tstav
04-09-2008, 02:33 PM
abesimpson, I'm out.

I know that four (4) hours ago you read my post with all my questions. You didn't care to answer. You didn't even say that you possibly had to go away and would be back later. That's a very strange kind of cooperation (to say the least).

My feeling is that you left us trying to decipher your initial post, without caring at all.

abesimpson
04-09-2008, 02:46 PM
Not at all, I read your email on my BB during a meeting and could not reply. I was not aware that I was supposed to respond under those circumstances, but now that I know you have my appology.

a

tstav
04-09-2008, 02:59 PM
No more comments.

rory
04-09-2008, 03:15 PM
I've altered two of your functions to take an optional worksheet argument (defaults to the activesheet if not specified) and adjusted your code ccordingly so you don't have to select a sheet for it to work:
Sub MakeXML() ' create an XML file from an Excel table
Dim MyRow As Long, MyCol As Long, Temp As String, DefFolder As String
Dim XMLFileName As String, XMLRecSetName As String, RTC1 As Long
Dim RangeOne As String, RangeTwo As String, Tt As String, FldName(99) As String
Dim wks As Worksheet

Set wks = Sheets("Portfolio")
Application.ScreenUpdating = False

DefFolder = "D:\Web Sync\" 'File Location

XMLFileName = "XMLFileName.xml" 'File Name

XMLRecSetName = "record"

RangeOne = "G7:L7" 'Field Names

MyRow = MyRng(RangeOne, 1, wks)
For MyCol = MyRng(RangeOne, 3, wks) To MyRng(RangeOne, 4, wks)
FldName(MyCol - MyRng(RangeOne, 3, wks)) = FillSpaces(wks.Cells(MyRow, MyCol).value)
Next MyCol

RangeTwo = "G8:L100" 'Data Range

RTC1 = MyRng(RangeTwo, 3, wks)

XMLFileName = DefFolder & XMLFileName

Open XMLFileName For Output As #1
Print #1, "<?xml version=" & Chr(34) & "1.0" & Chr(34) & " encoding=" & Chr(34) & "ISO-8859-1" & Chr(34) & "?>"
Print #1, "<hip2b2>"

For MyRow = MyRng(RangeTwo, 1, wks) To MyRng(RangeTwo, 2, wks)
Print #1, "<" & XMLRecSetName & ">"
For MyCol = RTC1 To MyRng(RangeTwo, 4, wks)
' the next line uses the FormChk function to format dates and numbers
Print #1, "<" & FldName(MyCol - RTC1) & ">" & RemoveAmpersands(FormChk(MyRow, MyCol, wks)) & "</" & FldName(MyCol - RTC1) & ">"
Next MyCol
Print #1, "</" & XMLRecSetName & ">"

Next MyRow
Print #1, "</hip2b2>"
Close #1

End Sub
Function MyRng(MyRangeAsText As String, MyItem As Integer, Optional wks As Worksheet) As Integer
' analyse a range, where MyItem represents 1=TR, 2=BR, 3=LHC, 4=RHC

Dim UserRange As Range
If wks Is Nothing Then Set wks = ActiveSheet
Set UserRange = wks.Range(MyRangeAsText)
Select Case MyItem
Case 1
MyRng = UserRange.Row
Case 2
MyRng = UserRange.Row + UserRange.Rows.Count - 1
Case 3
MyRng = UserRange.Column
Case 4
MyRng = UserRange.Columns(UserRange.Columns.Count).Column
End Select

End Function
Function FormChk(RowNum As Integer, ColNum As Integer, Optional wks As Worksheet) As String
' formats numeric and date cell values to comma 000's and DD MMM YY
If wks Is Nothing Then Set wks = ActiveSheet
With wks.Cells(RowNum, ColNum)
FormChk = .value
If IsNumeric(.value) Then FormChk = Format(.value, "#,##.####0;(#,##.####0)")
If IsDate(.value) Then FormChk = Format(.value, "dd mmm yy")
End With
End Function

abesimpson
04-09-2008, 03:26 PM
Traveling home now. I will test and get back with the results.

Many thanks for the help; and again my apologies.

a

abesimpson
04-09-2008, 05:05 PM
I get a Compile byref argument type mismatch error on line 38 of "Sub MakeXML()" Print #1, "<" & FldName(MyCol - RTC1) & ">" & RemoveAmpersands(FormChk(MyRow, MyCol, wks)) & "</" & FldName(MyCol - RTC1) & ">" "MyRow" is highlighted is the error message.

I suspect it's me not the code.

Thanks for your help

a

mdmackillop
04-10-2008, 05:14 AM
Hi Rory,
I've not followed all the code, but should MyRng be declared as Long if it can return a row number

rory
04-10-2008, 05:20 AM
Yep - I changed the Integer declarations to long at the last minute and missed a couple. Here's a revised version:
Sub MakeXML() ' create an XML file from an Excel table
Dim MyRow As Long, MyCol As Long, Temp As String, DefFolder As String
Dim XMLFileName As String, XMLRecSetName As String, RTC1 As Long
Dim RangeOne As String, RangeTwo As String, Tt As String, FldName(99) As String
Dim wks As Worksheet

Set wks = Sheets("Portfolio")
Application.ScreenUpdating = False

DefFolder = "D:\Web Sync\" 'File Location

XMLFileName = "XMLFileName.xml" 'File Name

XMLRecSetName = "record"

RangeOne = "G7:L7" 'Field Names

MyRow = MyRng(RangeOne, 1, wks)
For MyCol = MyRng(RangeOne, 3, wks) To MyRng(RangeOne, 4, wks)
FldName(MyCol - MyRng(RangeOne, 3, wks)) = FillSpaces(wks.Cells(MyRow, MyCol).Value)
Next MyCol

RangeTwo = "G8:L100" 'Data Range

RTC1 = MyRng(RangeTwo, 3, wks)

XMLFileName = DefFolder & XMLFileName

Open XMLFileName For Output As #1
Print #1, "<?xml version=" & Chr(34) & "1.0" & Chr(34) & " encoding=" & _
Chr(34) & "ISO-8859-1" & Chr(34) & "?>"
Print #1, "<hip2b2>"

For MyRow = MyRng(RangeTwo, 1, wks) To MyRng(RangeTwo, 2, wks)
Print #1, "<" & XMLRecSetName & ">"
For MyCol = RTC1 To MyRng(RangeTwo, 4, wks)
' the next line uses the FormChk function to format dates and numbers
Print #1, "<" & FldName(MyCol - RTC1) & ">" & _
RemoveAmpersands(FormChk(MyRow, MyCol, wks)) & _
"</" & FldName(MyCol - RTC1) & ">"
Next MyCol
Print #1, "</" & XMLRecSetName & ">"

Next MyRow
Print #1, "</hip2b2>"
Close #1

End Sub
Function MyRng(MyRangeAsText As String, MyItem As Integer, Optional wks As Worksheet) As Long
' analyse a range, where MyItem represents 1=TR, 2=BR, 3=LHC, 4=RHC

Dim UserRange As Range
If wks Is Nothing Then Set wks = ActiveSheet
Set UserRange = wks.Range(MyRangeAsText)
Select Case MyItem
Case 1
MyRng = UserRange.Row
Case 2
MyRng = UserRange.Row + UserRange.Rows.Count - 1
Case 3
MyRng = UserRange.Column
Case 4
MyRng = UserRange.Columns(UserRange.Columns.Count).Column
End Select

End Function
Function FormChk(RowNum As Long, ColNum As Long, Optional wks As Worksheet) As String
' formats numeric and date cell values to comma 000's and DD MMM YY
If wks Is Nothing Then Set wks = ActiveSheet
With wks.Cells(RowNum, ColNum)
FormChk = .Value
If IsNumeric(.Value) Then FormChk = Format(.Value, "#,##.####0;(#,##.####0)")
If IsDate(.Value) Then FormChk = Format(.Value, "dd mmm yy")
End With
End Function

abesimpson
04-10-2008, 08:28 AM
Great and thanks, I'll test and get back if I have any problems.



a

abesimpson
04-10-2008, 03:15 PM
Works a treat! I can't tell you how pleased I am with this macro. I only wish I had the skills to recipricate in kind.


Regards

a