fingermouse
Board Regular
- Joined
- Dec 13, 2013
- Messages
- 117
Hi,
I have been tasked with amending an existing macro. I'll do my best to explain.
For context, users enter ref numbers into a column on an existing excel worksheet e.g. cells (B6 to
B100000). The user then clicks a button to activate the macro. The macro creates a new worksheet
containing all the data relating to those ref numbers. The data is extracted from a database table.
It is 86 columns long while the number of rows is dependent on the quantity of ref numbers requested.
The output sheet has column headers which never change.
Its probably worth mentioning that the ref numbers input can relate to two separate periods. Before
clicking the button which activates the macro, users have to select either 'ECO1' or 'ECO2' from 2
radio buttons. Depending on what is selected, the macro will output the data to either a worksheet
called 'ECO1 Results' or one called 'ECO2 Results'.This may / or may not not be critical to my task
but thought I should mention it anyway.
Ultimately what I want is this:
• Retain the existing macro (assigned to button 1)
• Create a new macro which will only output specific columns from the database. e.g. ( columns C, AR,
AL, BW, AQ) and output them to a new worksheet in that column order / sequence. (assigned to button
2).
Basically macro 2 should do everything macro 1 does. But instead of outputting all columns, it
outputs specified columns/ranges.
Here is the existing module code.
Hope I've explained all this ok. Apologies for the long winded email to what is (hopefully) not a
very complex macro, but I thought I should provide as much info as possible
Any help would be much appreciated. Regards, Cal.
I have been tasked with amending an existing macro. I'll do my best to explain.
For context, users enter ref numbers into a column on an existing excel worksheet e.g. cells (B6 to
B100000). The user then clicks a button to activate the macro. The macro creates a new worksheet
containing all the data relating to those ref numbers. The data is extracted from a database table.
It is 86 columns long while the number of rows is dependent on the quantity of ref numbers requested.
The output sheet has column headers which never change.
Its probably worth mentioning that the ref numbers input can relate to two separate periods. Before
clicking the button which activates the macro, users have to select either 'ECO1' or 'ECO2' from 2
radio buttons. Depending on what is selected, the macro will output the data to either a worksheet
called 'ECO1 Results' or one called 'ECO2 Results'.This may / or may not not be critical to my task
but thought I should mention it anyway.
Ultimately what I want is this:
• Retain the existing macro (assigned to button 1)
• Create a new macro which will only output specific columns from the database. e.g. ( columns C, AR,
AL, BW, AQ) and output them to a new worksheet in that column order / sequence. (assigned to button
2).
Basically macro 2 should do everything macro 1 does. But instead of outputting all columns, it
outputs specified columns/ranges.
Here is the existing module code.
Code:
Sub UpdateQuery()
Application.Calculation = xlCalculationManual
StopSub = False
[COLOR=#008000]'1: check cell A1 contains 1 or 2
[/COLOR]
If Not Range("A1") = 1 Then
If Not Range("A1") = 2 Then MsgBox ("Error: Cell A1 should contain '1' for ECO1 or '2' for ECO2")
End If
ECOPeriod = Range("A1").Value
[COLOR=#008000]'2: Clear contents, check there's some MRNs in the list
[/COLOR]
Worksheets("ECO1 Results").Range("A2:BV1000000").ClearContents
Worksheets("ECO2 Results").Range("A2:CH1000000").ClearContents
If IsEmpty(Worksheets("List of MRNs").Range("B5")) Then End
[COLOR=#008000]'3:[/COLOR]
KeepPowerOn
ErrorTotal = 0
TotalMeasures = WorksheetFunction.Counta(Worksheets("List of MRNs").Range("B5:B1000000"))
[COLOR=#008000]'4: Start loop
[/COLOR]
For Counter = 1 To TotalMeasures
[COLOR=#008000]'5: Read MRN and enter it into relevant sheet
[/COLOR]
CurrentMRN = Worksheets("List of MRNs").Range("B4").Offset(Counter, 0).Value
If ECOPeriod = 1 Then
Worksheets("DWH Pivot & Workings").Range("F2").Value = CurrentMRN
End If
If ECOPeriod = 2 Then
Worksheets("DWH Pivot & Workings").Range("F23").Value = CurrentMRN
End If
[COLOR=#008000]'6: Calculate workings sheet
[/COLOR]
Worksheets("DWH Pivot & Workings").Calculate
DoEvents
[COLOR=#008000]'7: Update relevant table with new query
[/COLOR]
If ECOPeriod = 1 Then
On Error GoTo ErrorFound
With Worksheets("DWH Returns").Range("A3").ListObject.QueryTable
.Connection = Array( _
"OLEDB;Provider=MSOLAP.4;Integrated Security=SSPI;Persist Security Info=True;Initial Catalog=ECO;Data
Source=lonp-ecoBe01;MDX Compatibi" _
, "lity=1;Safety Options=2;MDX Missing Member Mode=Error")
.CommandType = xlCmdDefault
.BackgroundQuery = False
.CommandText = Worksheets("DWH Pivot & Workings").Range("F8").Value
.Refresh
End With
End If
If ECOPeriod = 2 Then
On Error GoTo ErrorFound
With Worksheets("ECO2 Returns").Range("A3").ListObject.QueryTable
.Connection = Array( _
"Provider=MSOLAP.4;Integrated Security=SSPI;Persist Security Info=True;Initial Catalog=ECO2;Data
Source=lonp-ECOBE01;MDX Compatibility=1;Safety Options=2;MDX Missing Member Mode=Error")
.CommandType = xlCmdDefault
.BackgroundQuery = False
.CommandText = Worksheets("DWH Pivot & Workings").Range("F32").Value
.Refresh
End With
End If
DoEvents
PasteRow = Counter + 1
DoEvents
[COLOR=#008000]'8: Copy results out
[/COLOR]
If ECOPeriod = 1 Then
ResultsPaste = "A" & PasteRow & ":BV" & PasteRow
Worksheets("DWH Returns").Range("A4:BV4").Copy
Worksheets("ECO1 Results").Range(ResultsPaste).PasteSpecial xlPasteValues
Worksheets("ECO1 Results").Visible = True
Worksheets("ECO1 Results").Activate
End If
If ECOPeriod = 2 Then
ResultsPaste = "A" & PasteRow & ":CH" & PasteRow
Worksheets("ECO2 Returns").Range("A4:CH4").Copy
Worksheets("ECO2 Results").Range(ResultsPaste).PasteSpecial xlPasteValues
Worksheets("ECO2 Results").Visible = True
Worksheets("ECO2 Results").Activate
End If
DoEvents
GoTo GoNext
[COLOR=#008000]'9: Error handling
[/COLOR]
ErrorFound:
ErrorTotal = ErrorTotal + 1
PasteRow = Counter + 1
If ECOPeriod = 1 Then
ResultsPaste = "A" & PasteRow & ":BV" & PasteRow
Worksheets("ECO1 Results").Range(ResultsPaste).Value = "NOT FOUND"
Worksheets("ECO1 Results").Range("D" & PasteRow).Value = Worksheets("List of MRNs").Range
("B4").Offset(Counter, 0).Value
Worksheets("ECO1 Results").Visible = True
Worksheets("ECO1 Results").Activate
End If
If ECOPeriod = 2 Then
ResultsPaste = "A" & PasteRow & ":CH" & PasteRow
Worksheets("ECO2 Results").Range(ResultsPaste).Value = "NOT FOUND"
Worksheets("ECO2 Results").Range("D" & PasteRow).Value = Worksheets("List of MRNs").Range
("B4").Offset(Counter, 0).Value
Worksheets("ECO2 Results").Visible = True
Worksheets("ECO2 Results").Activate
End If
Resume GoNext
[COLOR=#008000]'10 Update progress indicator
[/COLOR]
GoNext:
Progress.MeasuresRemaining = TotalMeasures - Counter
Progress.PercentComplete2 = (Counter / TotalMeasures) * 100
Progress.Repaint
If StopSub = True Then GoTo EndofSub
Next Counter
EndofSub:
If ErrorTotal > 0 Then MsgBox (ErrorTotal & " MRNs not found in DWH, marked as NOT FOUND")
StopTimer
Progress.Hide
End Sub
Hope I've explained all this ok. Apologies for the long winded email to what is (hopefully) not a
very complex macro, but I thought I should provide as much info as possible
Any help would be much appreciated. Regards, Cal.