garethtnash
asked on
Excel Automation VBA
I had this question after viewing Excel VBA When using VLookup.
Hello All,
I have an excel file that downloads from a web server. The worksheet has columns a -> BM
I would like to automate the following
Delete Row 1
Sort by C1 (xxx Employee Number) ASC
Cut from C1 into B1 where B1 is NULL and C1 in NOT NULL
Delete Column C
Select each value in column B and Convert to Number
In Column BG delete all rows where BG is not "xxx" or "yyy"
In Column BM add the following formula for each row '=IF(AND(BK2 = BJ2, BE2 > 0), "Current","")'
Copy the formula down for each row of data
Delete each Row where BM = "" (i.e. only have current data left)
Any ideas?
Thank you
Hello All,
I have an excel file that downloads from a web server. The worksheet has columns a -> BM
I would like to automate the following
Delete Row 1
Sort by C1 (xxx Employee Number) ASC
Cut from C1 into B1 where B1 is NULL and C1 in NOT NULL
Delete Column C
Select each value in column B and Convert to Number
In Column BG delete all rows where BG is not "xxx" or "yyy"
In Column BM add the following formula for each row '=IF(AND(BK2 = BJ2, BE2 > 0), "Current","")'
Copy the formula down for each row of data
Delete each Row where BM = "" (i.e. only have current data left)
Any ideas?
Thank you
Possible,
If we gonna delete row1 then your headers will be deleted.
Please explain your header starts from row 2 or 1?
If possible, please upload sample workbook.
If we gonna delete row1 then your headers will be deleted.
Please explain your header starts from row 2 or 1?
If possible, please upload sample workbook.
ASKER
Hi Shums,
Currently row 2 contains the headers - row 1 has the name of the report :)
And attached is an example workbook (normally contains 1000s of rows)
ExampleReport.xlsx
Currently row 2 contains the headers - row 1 has the name of the report :)
And attached is an example workbook (normally contains 1000s of rows)
ExampleReport.xlsx
Hi Gareth,
Please try below:
Please try below:
Sub Automation_VBA()
Dim Ws As Worksheet
Dim LR1 As Long, LR2 As Long
Dim r As Long
Dim i As Long
Dim Value$
With Application
.ScreenUpdating = False
.DisplayStatusBar = True
.StatusBar = "!!! Please Be Patient...Updating Records !!!"
.EnableEvents = False
.Calculation = xlManual
End With
Set Ws = Worksheets("Sheet1")
LR1 = Ws.Range("C" & Rows.Count).End(xlUp).Row
'Delete row 1
Ws.Rows(1).Delete
'Sort on Column C
Ws.Sort.SortFields.Clear
Ws.Sort.SortFields.Add Key:=Range("E2:E" & LR1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With Ws.Sort
.SetRange Range("A1:BM" & LR1)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'Copy Column C data to B
Ws.Range("C1:C" & LR1).Copy
Ws.Range("B1").PasteSpecial xlPasteValues
'Delete column C
Ws.Columns(3).Delete
'Convert Each Value in Column B and Covert to Number
With Ws.Range("B2:B" & LR1) 'Change As Needed
.NumberFormat = "General"
.Value = .Value
End With
'After deletion of column C, Column BG will become BF, to delete xxx & yyy
For r = LR1 To 2 Step -1
Value = Ws.Cells(r, 58).Value
If Not (Value Like "xxx" Or Value Like "yyy") Then
Ws.Rows(r).Delete
End If
Next
LR2 = Ws.Range("B" & Rows.Count).End(xlUp).Row
'After deletion of column C, Column BM will become BL, to add formula
Ws.Range("BL2:BL" & LR2).FormulaR1C1 = "=IF(AND(RC62 = RC61, RC56 > 0), ""Current"","""")"
'Delete blank cells in column BL
For i = LR2 To 2 Step -1
If Ws.Cells(i, 64) = "" Then
Ws.Rows(i).Delete
End If
Next
Ws.Range("B2").Select
With Application
.ScreenUpdating = True
.DisplayStatusBar = True
.StatusBar = False
.EnableEvents = True
.Calculation = xlAutomatic
End With
End Sub
Delete Row 1
Sort by C1 (xxx Employee Number) ASC
Cut from C1 into B1 where B1 is NULL and C1 in NOT NULL
Delete Column C
Select each value in column B and Convert to Number
In Column BG delete all rows where BG is not "xxx" or "yyy"
In Column BM add the following formula for each row '=IF(AND(BK2 = BJ2, BE2 > 0), "Current","")'
Copy the formula down for each row of data
Delete each Row where BM = "" (i.e. only have current data left)
1. Delete Row 1 is fine
2. Sort C1(xxx Employee Number)ASC, its in Column B not Column C
3. Cut from C1 To B1 where B1 is NULL and C1 in NOT NULL : Column C is empty and B is Full
4. Select each value in column B and Convert to Number, your example is having alpha numeric Employee ID, what to convert to Number?
5. In Column BG delete all rows where BG is not "xxx" or "yyy". Column BG has just GGGGG nothing found of "xxx" or "yyy"
6. In Column BM add the following formula for each row '=IF(AND(BK2 = BJ2, BE2 > 0), "Current","")'
In Column BM you have time sheet submitted date, where would you want this formula?
ASKER
Hi Shums
Thanks - it's a good start, but not quite there :(
So some thoughts
Can we do this first -
Then sort Column C - there will be Blank Cells, I only want to copy the cells that are not blank so -
Will this sort on column C ascending?
will this only select cells from Column C where data exists?
Paste data in column B -
If you can get me this far, I'll try the next - thank you
Thanks - it's a good start, but not quite there :(
So some thoughts
Can we do this first -
'Delete row 1
Ws.Rows(1).Delete
Then sort Column C - there will be Blank Cells, I only want to copy the cells that are not blank so -
Will this sort on column C ascending?
'Sort on Column C
Ws.Sort.SortFields.Clear
Ws.Sort.SortFields.Add Key:=Range("E2:E" & LR1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With Ws.Sort
.SetRange Range("A1:BM" & LR1)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Is this correct ? Range("E2:E" & LR1)
will this only select cells from Column C where data exists?
Set Ws = Worksheets("Sheet1")
LR1 = Ws.Range("C" & Rows.Count).End(xlUp).Row
Paste data in column B -
'Copy Column C data to B
Ws.Range("C1:C" & LR1).Copy
Ws.Range("B1").PasteSpecial xlPasteValues
Will this leave cells where the cell in C is blank?
If you can get me this far, I'll try the next - thank you
Hi Gareth,
I did followed your step
1st to delete first row
2nd to sort Column C by Employee ID
Please paste below, its a mistake from my part, I sort data in Column E
Below code you can change which column has the data until the last row:
Please let me know, you need some other changes
I did followed your step
1st to delete first row
2nd to sort Column C by Employee ID
Please paste below, its a mistake from my part, I sort data in Column E
'Sort on Column C
Ws.Sort.SortFields.Clear
Ws.Sort.SortFields.Add Key:=Range("C2:C" & LR1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With Ws.Sort
.SetRange Range("A1:BM" & LR1)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Below code you can change which column has the data until the last row:
Set Ws = Worksheets("Sheet1")
LR1 = Ws.Range("C" & Rows.Count).End(xlUp).Row 'Change column as required
Below code is correct, it copies from C to B then deletes C'Copy Column C data to B
Ws.Range("C1:C" & LR1).Copy
Ws.Range("B1").PasteSpecial xlPasteValues
Please let me know, you need some other changes
ASKER
Hi Rey,
Thanks, yes I know how to record a macro, however what I need to do here is actions based on cell / row values - i.e. delete row if cell ah4 = ""
When you record a macro, it doesn't recognise that you are deleting rows 2, 4 and 12 because cell ah2, ah4 and ah 12 have a NULL value, just that you are deleting rows 2,4 and 12.
I need the logic to delete based on select queries.
Thanks
Thanks, yes I know how to record a macro, however what I need to do here is actions based on cell / row values - i.e. delete row if cell ah4 = ""
When you record a macro, it doesn't recognise that you are deleting rows 2, 4 and 12 because cell ah2, ah4 and ah 12 have a NULL value, just that you are deleting rows 2,4 and 12.
I need the logic to delete based on select queries.
Thanks
Gareth,
With the edited code, is my VBA helping you?
With the edited code, is my VBA helping you?
ASKER
Hi Shums, it is but I'm struggling to pull it all together :)
Could you upload your workbook?
ASKER
Sorry Shums,
I've not had a chance to look at this today, I'll upload tomorrow :)
I've not had a chance to look at this today, I'll upload tomorrow :)
ASKER
Hi,
I've made good progress with the macro below -
However when I run this currently, I get a run-time error '424' object expected on the line below -
I'm also getting an issue with
'Its a run-time 424 again..
Any thoughts?
Thanks
I've made good progress with the macro below -
Sub FGTS()
Set Ws = Worksheets("FG TS")
Ws.Rows(1).Delete
Rows("1:1").Select
Selection.Font.Bold = True
Selection.AutoFilter
ActiveWorkbook.Worksheets("FG TS").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("FG TS").AutoFilter.Sort.SortFields.Add Key:=Range( _
"C1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("FG TS").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Ws.Range("C2").Select
Ws.Range(Selection, Selection.End(xlDown)).Select
Ws.Range(Selection, Selection.End(xlDown)).Copy
Ws.Range("B2").PasteSpecial xlPasteValues
ActiveWorkbook.Worksheets("FG TS").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("FG TS").AutoFilter.Sort.SortFields.Add Key:=Range( _
"B1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("FG TS").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'Ws.Range("B2").Select
'Ws.Range(Selection, Selection.End(xlDown)).Select
'With Ws.Range(B2, B2.End(xlDown))
'.NumberFormat = "General"
'.Value = .Value
'End With
Ws.Columns(3).Delete
LR2 = Range("A" & Rows.Count).End(xlUp).Row
Ws.Range("BM1").FormulaR1C1 = "Current TS?"
Ws.Range("BM2:BM" & LR2).FormulaR1C1 = "=IF(AND(RC63 = RC62, RC57 > 0), ""Current"", """
However when I run this currently, I get a run-time error '424' object expected on the line below -
With Ws.Range(B2, B2.End(xlDown))
I'm also getting an issue with
Ws.Range("BM2:BM" & LR2).FormulaR1C1 = "=IF(AND(RC63 = RC62, RC57 > 0), ""Current"", """
'Its a run-time 424 again..
Any thoughts?
Thanks
Gareth,
It would be very helpful, if you upload your original workbook, because you are deleting one column before applying formula in BM Column, it should be followed step by step.
Else try below:
It would be very helpful, if you upload your original workbook, because you are deleting one column before applying formula in BM Column, it should be followed step by step.
Else try below:
Sub Automation_VBA()
Dim Ws As Worksheet
Dim LR1 As Long, LR2 As Long
Dim r As Long
Dim i As Long
Dim Value$
With Application
.ScreenUpdating = False
.DisplayStatusBar = True
.StatusBar = "!!! Please Be Patient...Updating Records !!!"
.EnableEvents = False
.Calculation = xlManual
End With
Set Ws = Worksheets("FG TS")
LR1 = Ws.Range("A" & Rows.Count).End(xlUp).Row
'Delete row 1
Ws.Rows(1).Delete
'Sort on Column C
Ws.Sort.SortFields.Clear
Ws.Sort.SortFields.Add Key:=Range("C2:C" & LR1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With Ws.Sort
.SetRange Range("A1:BM" & LR1)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'Copy Column C data to B
Ws.Range("C1:C" & LR1).Copy
Ws.Range("B1").PasteSpecial xlPasteValues
'Delete column C
Ws.Columns(3).Delete
'Convert Each Value in Column B and Covert to Number
With Ws.Range("B2:B" & LR1) 'Change As Needed
.NumberFormat = "General"
.Value = .Value
End With
'After deletion of column C, Column BG will become BF, to delete xxx & yyy
For r = LR1 To 2 Step -1
Value = Ws.Cells(r, 58).Value
If Not (Value Like "xxx" Or Value Like "yyy") Then
Ws.Rows(r).Delete
End If
Next
LR2 = Ws.Range("A" & Rows.Count).End(xlUp).Row
'After deletion of column C, Column BM will become BL, to add formula
Ws.Range("BL2:BL" & LR2).FormulaR1C1 = "=IF(AND(RC62 = RC61, RC56 > 0), ""Current"","""")"
'Delete blank cells in column BL
For i = LR2 To 2 Step -1
If Ws.Cells(i, 64) = "" Then
Ws.Rows(i).Delete
End If
Next
Ws.Range("B2").Select
With Application
.ScreenUpdating = True
.DisplayStatusBar = True
.StatusBar = False
.EnableEvents = True
.Calculation = xlAutomatic
End With
End Sub
ASKER
Hi Shums,
Attached sample workbook, have made good progress except with the last bit of the code - it just loops and consumes resources -
Thank you
Book2.xlsx
Attached sample workbook, have made good progress except with the last bit of the code - it just loops and consumes resources -
Sub FGTS()
Set Ws = Worksheets("FG TS")
Ws.Rows(1).Delete
Rows("1:1").Select
Selection.Font.Bold = True
Selection.AutoFilter
ActiveWorkbook.Worksheets("FG TS").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("FG TS").AutoFilter.Sort.SortFields.Add Key:=Range( _
"C1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("FG TS").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Ws.Range("C2").Select
Ws.Range(Selection, Selection.End(xlDown)).Select
Ws.Range(Selection, Selection.End(xlDown)).Copy
Ws.Range("B2").PasteSpecial xlPasteValues
ActiveWorkbook.Worksheets("FG TS").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("FG TS").AutoFilter.Sort.SortFields.Add Key:=Range( _
"B1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("FG TS").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'Ws.Range("B2").Select
'Ws.Range(Selection, Selection.End(xlDown)).Select
Range("B:B").Select 'specify the range which suits your purpose
With Selection
Selection.NumberFormat = "General"
.Value = .Value
End With
Ws.Columns(3).Delete
LR2 = Range("A" & Rows.Count).End(xlUp).Row
Ws.Range("BM1").FormulaR1C1 = "Current TS?"
Ws.Range("BM2:BM" & LR2).FormulaR1C1 = "=IF(AND(RC[-2] = RC[-3], RC[-8] > 0), ""Current"","""")"
'Delete blank cells from column BM
For i = LR2 To 2 Step -1
If Ws.Cells(i, 65) = "" Then
Ws.Rows(i).Delete
End If
Next
End Sub
Thank you
Book2.xlsx
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Fantastic - thank you
You're welcome Gareth! Glad I was able to help.
see how to this from Record Excel Macro