PDA

View Full Version : [SOLVED] Macro from this pseudo code?



tx7399
07-30-2015, 07:07 PM
Any help converting this pseudo code into vba would be greatly appreciated. Can it be done using the .Find method? Or Application.WorksheetFunction Index Match?

For each value in sheet 2 Col A
If not found in sheet1 Col B then

Sheet 2 Col A. entire row. Delete

End if

If found in sheet 1 Col B then

If sheet 2 Col A.Offset(0,3). value = sheet 1 Col B.Offset(0,15). Value then

Sheet 2 Col A.Offset(0,4).value = “TAC”

Else

Sheet 2 Col A.Offset(0,4).value = “”

End if

End if

Next

mancubus
07-31-2015, 12:05 AM
test with a copy of your file

i assume there is only 1 match in sheet1.



Sub vbax_53342_match_in_another_sheet()

Dim cll As Range, ValuesRange As Range

With Worksheets("Sheet2").Columns(1)
Set ValuesRange = Union(.SpecialCells(xlCellTypeConstants), .SpecialCells(xlCellTypeFormulas))
'when column contains both constants and formulas
'=
'Set ValuesRange = Union(.SpecialCells(2), .SpecialCells(-4123))
'Set ValuesRange = .SpecialCells(xlCellTypeConstants) 'only constants in column
'Set ValuesRange = .SpecialCells(xlCellTypeFormulas) 'if formulas in column
End With

For Each cll In ValuesRange
If Application.CountIf(Worksheets("Sheet1").Columns(2), cll.Value) = 0 Then
Worksheets("Sheet2").Rows(cll.Row).Delete
Else
FoundRow = Application.Match(cll.Value, Worksheets("Sheet1").Columns(2), 0)
If cll.Offset(0, 3).Value = Worksheets("Sheet1").Cells(FoundRow, 2).Offset(0, 15).Value Then
cll.Offset(0, 4).Value = "TAC"
Else
cll.Offset(0, 4).Value = ""
End If
End If
Next

End Sub

tx7399
07-31-2015, 03:21 PM
mancubus,

Thank you! I really appreciate your help. Sorry it took so long to get back to you. I used
Set ValuesRange = .SpecialCells(xlCellTypeConstants) 'only constants in column
because there are no formulas in the sheet.
The code runs fast but it doesn't delete all the rows where the sheet2 cell value does not exist
in sheet1 col B and I don't understand why. I have attached test data so you can see what I mean.
Sheet 2 rows 13-17 should be deleted but are not. What have I done wrong?

Regards,
Paul

tx7399
07-31-2015, 03:32 PM
Sorry, I forgot to attach this.

14045

p45cal
08-01-2015, 08:50 AM
Your attached TestData.xlsm isn't a very good file to test on since no rows need deleteing.
That aside, the problem is that the code runs down the cells in Sheet2, so when a row is deleted it skips a line altogether when it processes the next one. You need to run up those cells.
Change the line:
For Each cll In ValuesRange
to two lines:
For i = ValuesRange.Cells.Count To 1 Step -1
Set cll = ValuesRange.Cells(i)

Now this will work well, but only if the cells in ValuesRange are all contiguous.
To get round this we have to work through each of the areas of ValuesRange, working our way up through each of them, so:
Sub vbax_53342_match_in_another_sheet()
Dim cll As Range, ValuesRange As Range

Set ValuesRange = Worksheets("Sheet2").Columns(1).SpecialCells(xlCellTypeConstants) 'only constants in column
For Each are In ValuesRange.Areas
For i = are.Cells.Count To 1 Step -1
Set cll = are.Cells(i)
If Application.CountIf(Worksheets("Sheet1").Columns(2), cll.Value) = 0 Then
Worksheets("Sheet2").Rows(cll.Row).Delete
Else
FoundRow = Application.Match(cll.Value, Worksheets("Sheet1").Columns(2), 0)
If cll.Offset(0, 3).Value = Worksheets("Sheet1").Cells(FoundRow, 2).Offset(0, 15).Value Then
cll.Offset(0, 4).Value = "TAC"
Else
cll.Offset(0, 4).Value = ""
End If
End If
Next i
Next are
End Subshould work whether ValuesRange is contiguous or not.

tx7399
08-01-2015, 01:55 PM
Thank you p45cal. Works perfectly.