VBA Macro

[nhiribarne]

Hi,

I would like to know if you can help me on building a macro on the attached file 12855
My goal is to build a macro which will permitt me to delete the lines of which the "Recon. Ref" are the same but the "Amout" are opposite.
I would like to get from the sheet "Database" to the sheet "Goal".
I'm new in VBA so I don't have lot of idea to build this macro.

Thank you very much if somebody is able to help me, Regard.

[nhiribarne]

I try to write a code, I could have write this one but it's not workin really well haha

Sub ReconcileAccounts()Dim i As Integer
For i = 2 To 1500
If Cells(i, 1) = Cells(i + 1, 1) Then
If Cells(i, 2) + Cells(i + 1, 2) = 0 Then
Rows(i).EntireRow.Delete
Rows(i).EntireRow.Delete
End If
End If
Next i
End Sub

At least, if I run my macro 30 times in a row, I get the result I want but it's slow and doesn't do what I want in the first go :-)
I will work on it on Monday again, if some of you have some tips to help me, you are welcome :-)

[mancubus]

welcome to VBAX.

as per forum rules, please choose an appropriate title to the thread.


try this:


Sub ReconcileAccounts()

Dim calc As Long, LastRow As Long, i As Long

With Application
.DisplayAlerts = False
.ScreenUpdating = False
.EnableEvents = False
calc = .Calculation
.Calculation = xlCalculationManual
End With

With Worksheets("Database")
If .AutoFilterMode Then .AutoFilterMode = False

LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row

For i = LastRow To 3 Step -1 '3 so that the last iteration of i - 1 equals to 2
If .Cells(i - 1, 1) = .Cells(i, 1) And .Cells(i - 1, 2) + Cells(i, 2) = 0 Then
Rows(i - 1 & ":" & i).EntireRow.Delete
End If
Next i
End With

With Application
.EnableEvents = True
.Calculation = calc
End With

End Sub

[nhiribarne]

Ok, the macro you sent me work perfectly and is so fast. Love it :-) I have to learn to code as good as you do !
I have one more question, I would like to do the same job in this file, with data which are not well sorted and I would like to be able to selec the data by myself thanks to an inputbox or something. Could you give me some guidelines in order to do that?

Cheers.

12861

[mancubus]

you are welcome.

first off, a correction:


If .Cells(i - 1, 1) = .Cells(i, 1) And .Cells(i - 1, 2) + .Cells(i, 2) = 0 Then

because of With - End With block we need a dot before Cells(i, 2).

Cells(RowRef, ColumnRef) enables you to change the olumn number. for the second file they are 8 (column H) and 15 (column O).

[mancubus]

Sub ReconcileAccounts()
Dim calc As Long, LastRow As Long, i As Long

With Application
.DisplayAlerts = False
.ScreenUpdating = False
.EnableEvents = False
calc = .Calculation
.Calculation = xlCalculationManual
End With

With Worksheets("Database")
If .AutoFilterMode Then .AutoFilterMode = False

LastRow = .Cells(.Rows.Count, 8).End(xlUp).Row

For i = LastRow To 3 Step -1 '3 so that the last iteration of i - 1 equals to 2
If .Cells(i - 1, 8) = .Cells(i, 8) And .Cells(i - 1, 15) + .Cells(i, 15) = 0 Then
Rows(i - 1 & ":" & i).EntireRow.Delete
End If
Next i
End With
With Application
.EnableEvents = True
.Calculation = calc
End With
End Sub

[nhiribarne]

Ok, I thought about that but I wanted to be able to chose the data or at least the array with an inputbox. But anyway, that's convenient enough, thank you.

I tried to do the same with an array where the data are not sorted. So, my goal is to compare a line of the table with all the other line and delete them if the Recon. Ref are the same and the amount are opposite.

I thought about something like that, add a variable and do a double loop to be able to compare one line with all the others but I may have done something wrong.

Hope I m clear enough in my explanation:

Sub ReconcileAccounts()
Dim calc As Long, LastRow As Long, i As Long, j As Long

With Application
.DisplayAlerts = False
.ScreenUpdating = False
.EnableEvents = False
calc = .Calculation
.Calculation = xlCalculationManual
End With

With Worksheets("Data evidences")
If .AutoFilterMode Then .AutoFilterMode = False

LastRow = .Cells(.Rows.Count, 8).End(xlUp).Row

For i = LastRow To 3 Step -1 '3 so that the last iteration of i - 1 equals to 2
For j = LastRow To 3 Step -1
If .Cells(i, 8) = .Cells(j, 8) And .Cells(i, 15) + .Cells(j, 15) = 0 Then
Rows(i & ":" & j).EntireRow.Delete
End If
Next j
Next i
End With
With Application
.EnableEvents = True
.Calculation = calc
End With
End Sub

[mancubus]

please use code tags when posting code.
# button will insert these tags for you. just paste the code between tags [ code ] and [ /code ]


yes you can. but it will add a lot of lines to the code.

you dont need another loop; just sort the table based on reconciliation reference.

user input for column numbers:



Sub ReconcileAccounts_Inputbox_Method()
'https://msdn.microsoft.com/en-us/library/office/ff839468.aspx

Dim calc As Long, LastRow As Long, i As Long, ColRef As Long, ColAmount As Long

ColRef = Application.InputBox(Prompt:="Enter Recon. Ref's column number", Type:=1)
If ColRef = False Then
MsgBox "You pressed Cancel button. Exiting..."
Exit Sub
End If

ColAmount = Application.InputBox(Prompt:="Enter Recon. Ref's column number", Type:=1)
If ColAmount = False Then
MsgBox "You pressed Cancel button. Exiting..."
Exit Sub
End If

With Application
.DisplayAlerts = False
.ScreenUpdating = False
.EnableEvents = False
calc = .Calculation
.Calculation = xlCalculationManual
End With

With Worksheets("Database")
If .AutoFilterMode Then .AutoFilterMode = False
.Cells(1).Sort Key1:=.Range("H2"), Order1:=xlAscending 'sorts ascending the table on reconciliation reference

LastRow = .Cells(.Rows.Count, 8).End(xlUp).Row

For i = LastRow To 3 Step -1 '3 so that the last iteration of i - 1 equals to 2
If .Cells(i - 1, ColRef) = .Cells(i, ColRef) And .Cells(i - 1, ColAmount) + .Cells(i, ColAmount) = 0 Then
Rows(i - 1 & ":" & i).EntireRow.Delete
End If
Next i
End With

With Application
.EnableEvents = True
.Calculation = calc
End With

End Sub


Lines related with Inputbox are written before disabling DisplayAlerts in case user inputs a non numeric value.

[mancubus]

below will look up words "Recon. Ref" and éAmount" in row 1 and retuns their column numbers if found.



Sub ReconcileAccounts_Find_Method()
'https://msdn.microsoft.com/en-us/library/office/ff839746.aspx


Dim calc As Long, LastRow As Long, i As Long, ColRef As Long, ColAmount As Long
Dim CellRef As Range, CellAmount As Range

With Application
.DisplayAlerts = False
.ScreenUpdating = False
.EnableEvents = False
calc = .Calculation
.Calculation = xlCalculationManual
End With

With Worksheets("Database")
If .AutoFilterMode Then .AutoFilterMode = False

On Error Resume Next
Set CellRef = .Rows(1).Find("Recon. Ref")
On Error GoTo 0

If Not CellRef Is Nothing Then
ColRef = CellRef.Column
Else
MsgBox "Header 'Recon. Ref' not found in Row 1 of table. Exiting..."
Exit Sub
End If

On Error Resume Next
Set CellAmount = .Rows(1).Find("Amount")
On Error GoTo 0

If Not CellAmount Is Nothing Then
ColAmount = CellAmount.Column
Else
MsgBox "Header 'Amount' not found in Row 1 of table. Exiting..."
Exit Sub
End If

.Cells(1).Sort Key1:=.Range("H2"), Order1:=xlAscending 'sorts ascending the table on reconciliation reference

LastRow = .Cells(.Rows.Count, 8).End(xlUp).Row

For i = LastRow To 3 Step -1 '3 so that the last iteration of i - 1 equals to 2
If .Cells(i - 1, ColRef) = .Cells(i, ColRef) And .Cells(i - 1, ColAmount) + .Cells(i, ColAmount) = 0 Then
Rows(i - 1 & ":" & i).EntireRow.Delete
End If
Next i
End With

With Application
.EnableEvents = True
.Calculation = calc
End With

End Sub

[nhiribarne]

Ok, I didn't know how to put the code qs you did, now it's all good.



Sub ReconcileAccounts_Find_Method()
'https://msdn.microsoft.com/en-us/library/office/ff839746.aspx

Dim calc As Long, LastRow As Long, i As Long, ColRef As Long, ColAmount As Long
Dim CellRef As Range, CellAmount As Range

With Application
.DisplayAlerts = False
.ScreenUpdating = False
.EnableEvents = False
calc = .Calculation
.Calculation = xlCalculationManual
End With

With Worksheets("Database")
If .AutoFilterMode Then .AutoFilterMode = False

On Error Resume Next
Set CellRef = .Rows(1).Find("Recon. Ref")
On Error GoTo 0

If Not CellRef Is Nothing Then
ColRef = CellRef.Column
Else
MsgBox "Header 'Recon. Ref' not found in Row 1 of table. Exiting..."
Exit Sub
End If

On Error Resume Next
Set CellAmount = .Rows(1).Find("Amount")
On Error GoTo 0

If Not CellAmount Is Nothing Then
ColAmount = CellAmount.Column
Else
MsgBox "Header 'Amount' not found in Row 1 of table. Exiting..."
Exit Sub
End If

Rows(1).EntireRow.Delete

.Cells(1).Sort Key1:=.Range("H2"), Order1:=xlAscending 'sorts ascending the table on reconciliation reference

LastRow = .Cells(.Rows.Count, 8).End(xlUp).Row

For i = LastRow To 3 Step -1 '3 so that the last iteration of i - 1 equals to 2
If .Cells(i - 1, ColRef) = .Cells(i, ColRef) And .Cells(i - 1, ColAmount) + .Cells(i, ColAmount) = 0 Then
Rows(i - 1 & ":" & i).EntireRow.Delete
End If
Next i
End With

With Application
.EnableEvents = True
.Calculation = calc
End With
End Sub


Apparently, there is a problem with the data type. I tried to add a line to delete the first row so there will be no text anymore. But it's not working. And sometime, when I run the macro, it delete some rows in the sheet Guidelines.
Do you have any idea why?

Please, find the more updated version I tried to create.
12864

Thank you very much for your help.
PS: Where did you learn to code like that? What is the best way for me to learn to code? apart of spending time on this forum which I already do :-D )

[mancubus]

somehow 'sort' does not recognize first row as header row.

try this:



Sub ReconcileAccounts_Find_Method()
'https://msdn.microsoft.com/en-us/library/office/ff839746.aspx

Dim calc As Long, LastRow As Long, i As Long, ColRef As Long, ColAmount As Long
Dim CellRef As Range, CellAmount As Range

With Application
.DisplayAlerts = False
.ScreenUpdating = False
.EnableEvents = False
calc = .Calculation
.Calculation = xlCalculationManual
End With

With Worksheets("Database")
If .AutoFilterMode Then .AutoFilterMode = False

On Error Resume Next
Set CellRef = .Rows(1).Find("Recon. Ref")
On Error GoTo 0

If Not CellRef Is Nothing Then
ColRef = CellRef.Column
Else
MsgBox "Header 'Recon. Ref' not found in Row 1 of table. Exiting..."
Exit Sub
End If

On Error Resume Next
Set CellAmount = .Rows(1).Find("Amount")
On Error GoTo 0

If Not CellAmount Is Nothing Then
ColAmount = CellAmount.Column
Else
MsgBox "Header 'Amount' not found in Row 1 of table. Exiting..."
Exit Sub
End If

LastRow = .Cells(.Rows.Count, ColRef).End(xlUp).Row

.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=.Range(.Cells(2, ColRef), .Cells(LastRow, ColRef)) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With .Sort
.SetRange Range("A1:U" & LastRow)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

For i = LastRow To 3 Step -1 '3 so that the last iteration of i - 1 equals to 2
If .Cells(i - 1, ColRef) = .Cells(i, ColRef) And .Cells(i - 1, ColAmount) + .Cells(i, ColAmount) = 0 Then
Rows(i - 1 & ":" & i).EntireRow.Delete
End If
Next i
End With

With Application
.EnableEvents = True
.Calculation = calc
End With

End Sub

[nhiribarne]

No error comming up but it's not working.
When I run the macro, all the data in my sheet Database are sorted (and selected ...) but it didn't delete the opposite rows.
Can't find why.

If needed:12865

[mancubus]

see attached file...



Sub ReconcileAccounts_Find_Method()
'https://msdn.microsoft.com/en-us/library/office/ff839746.aspx

Dim calc As Long, LastRow As Long, LastCol As Long, i As Long, ColRef As Long, ColAmount As Long
Dim CellRef As Range, CellAmount As Range, RangeSort As Range

With Application
.DisplayAlerts = False
.ScreenUpdating = False
.EnableEvents = False
calc = .Calculation
.Calculation = xlCalculationManual
End With

With Worksheets("Database")
If .AutoFilterMode Then .AutoFilterMode = False

On Error Resume Next
Set CellRef = .Rows(1).Find("Recon. Ref")
On Error GoTo 0

If Not CellRef Is Nothing Then
ColRef = CellRef.Column
Else
MsgBox "Header 'Recon. Ref' not found in Row 1 of table. Exiting..."
Exit Sub
End If

On Error Resume Next
Set CellAmount = .Rows(1).Find("Amount")
On Error GoTo 0

If Not CellAmount Is Nothing Then
ColAmount = CellAmount.Column
Else
MsgBox "Header 'Amount' not found in Row 1 of table. Exiting..."
Exit Sub
End If

LastRow = .Cells(.Rows.Count, ColRef).End(xlUp).Row
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
Set RangeSort = .Range(.Cells(1, 1), .Cells(LastRow, LastCol))

.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=.Range(.Cells(2, ColRef), .Cells(LastRow, ColRef)), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With .Sort
.SetRange RangeSort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

For i = LastRow To 3 Step -1 '3 so that the last iteration of i - 1 equals to 2
If .Cells(i - 1, ColRef) = .Cells(i, ColRef) And .Cells(i - 1, ColAmount) + .Cells(i, ColAmount) = 0 Then
Rows(i - 1 & ":" & i).EntireRow.Delete
End If
Next i
End With

With Application
.EnableEvents = True
.Calculation = calc
End With

End Sub

[mancubus]

thanks. i'm a learner.

to improve vba skills;
take on-line (vba express provides) or in-house training
read a lot
follow excel communities like this forum
work hard
try to provide solutions to questions asked in communities
re-write the codes provided by excel masters to questions asked in communities

[nhiribarne]

Ok, thank you very much for the macro.
It's working now. My problem was that I was tunning the macro from the sheet "Guidelines" thanks to a button and it was not working.
I tried to work run the macro from the sheet "Database" and it's working perfectly now :-)
My bad I didn't try it before.
Thank you very much for your help, and for all the advices you gave me to improve my VBA skills, will work hard ;-)

PS: I'll put this throat as resolved this evening (in case you have something to add)

[mancubus]

you are welcome.

keep writing/pasting your codes in standard code modules until you are familiar with MS Excel Objects (Sheets, ThisWorkbook).
in VBE: Insert, Module)

[nhiribarne]

Ok, get it, thank you very much.