Excel sheet focus problem

[abesimpson]

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]

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 [vba]Sheets("Portfolio").Select
[/vba]
and add "Sheets("Portfolio")." to the
[vba]FillSpaces(Sheets("Portfolio").Cells(MyRow, MyCol).value)
[/vba]

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

[abesimpson]

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]

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]

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]

No more comments.

[rory]

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:
[VBA]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
[/VBA]

[abesimpson]

Traveling home now. I will test and get back with the results.

Many thanks for the help; and again my apologies.

a

[abesimpson]

I get a Compile byref argument type mismatch error on line 38 of "Sub MakeXML()"[vba] Print #1, "<" & FldName(MyCol - RTC1) & ">" & RemoveAmpersands(FormChk(MyRow, MyCol, wks)) & "</" & FldName(MyCol - RTC1) & ">"[/vba] "MyRow" is highlighted is the error message.

I suspect it's me not the code.

Thanks for your help

a

[mdmackillop]

Hi Rory,
I've not followed all the code, but should MyRng be declared as Long if it can return a row number

[rory]

Yep - I changed the Integer declarations to long at the last minute and missed a couple. Here's a revised version:
[VBA]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
[/VBA]

[abesimpson]

Great and thanks, I'll test and get back if I have any problems.



a

[abesimpson]

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