VBA advice...

mrkambo · 4 Jun 2017 at 19:52

Im not very good with VBA, but i need to do some stuff and im hoping someone can help....

I have a excel spreadsheet which contains about ~25000 rows of data across 15 columns, im trying to show specific information from a select few cells, this sheet is called 'Source'

Code:

Private Sub sortfails_Click()
'This checks if source is loaded
Dim rn As Integer
sheetexists = False
For Each ws In ThisWorkbook.Worksheets
If ws.Name = "Source" Then
sheetexists = True
End If
Next ws
If sheetexists = False Then
MsgBox "Source File Doesn't Exist, Import source file", vbInformation, "test"
End If

'This is the search function

search:
Dim x As Integer
Dim Lastrow As Long
Dim Lastrowa As Long
Application.ScreenUpdating = False

Lastrow = Sheets("Source").Cells(Rows.Count, "L").End(xlUp).Row
Lastrowa = Sheets("Report").Cells(Rows.Count, "A").End(xlUp).Row + 1

If Left(Sheets("Source").Cells(x, 12), 7) = "FD" Then

Sheets("Report").Range("A" & Lastrowa).Value = SearchRange.Offset(, 1).Value
Sheets("Report").Range("B" & Lastrowa).Value = SearchRange.Offset(, -9).Value
Sheets("Report").Range("C" & Lastrowa).Value = SearchRange.Offset(, -8).Value
Sheets("Report").Range("D" & Lastrowa).Value = SearchRange.Offset(, 3).Value


End If
Exit Sub
End Sub

Where ive been trying different things to get the results i want, i think ive got something, but not sure how to VBA it.

So after this 'If Left(Sheets("Source").Cells(x, 12), 7) = "FD" Then'

I need the following values ignore the searchrange, i was using search before to see if could get the results i wanted, it worked but i couldnt get a loop function working correctly for it

Sheets("Report").Range("A" & Lastrowa).Value = SearchRange.Offset(, 1).Value
Sheets("Report").Range("B" & Lastrowa).Value = SearchRange.Offset(, -9).Value
Sheets("Report").Range("C" & Lastrowa).Value = SearchRange.Offset(, -8).Value
Sheets("Report").Range("D" & Lastrowa).Value = SearchRange.Offset(, 3).Value

But im not sure how to implement it, any help would be appreciated.

Grrrrr · 8 Jun 2017 at 13:36

Something like this?

Code:

Dim n as long

For n = 1 to Lastrow
  
     If Left(Sheets("Source").Cells(n, 12), 7) = "FD" then
          Sheets("Report").Range("A" & Lastrowa).Value = Sheets("Source").Cells(n, 13).Value
          Sheets("Report").Range("B" & Lastrowa).Value = Sheets("Source").Cells(n, 3).Value
          Sheets("Report").Range("C" & Lastrowa).Value = Sheets("Source").Cells(n, 4).Value
          Sheets("Report").Range("D" & Lastrowa).Value = Sheets("Source").Cells(n, 15).Value
     End If

next n

Another thing, in the "If" line you're comparing the left 7 characters with a 2 charater string ("FD"). Shouldn't it be the left two characters?

mrkambo · 8 Jun 2017 at 18:54

Grrrrr said:
Another thing, in the "If" line you're comparing the left 7 characters with a 2 charater string ("FD"). Shouldn't it be the left two characters?

Oh yeah, never clocked that, there is only ever 2 characters in that field anyway

So this works

Code:

Private Sub sortfails_Click()
'This checks if source is loaded
Dim rn As Integer
sheetexists = False
For Each ws In ThisWorkbook.Worksheets
If ws.Name = "Source" Then
sheetexists = True
End If
Next ws
If sheetexists = False Then
MsgBox "Source File Doesn't Exist, Import source file", vbInformation, "test"
End If

'This is the search function

search:
Dim x As Integer
Dim Lastrow As Long
Dim Lastrowa As Long
Dim n As Long
Application.ScreenUpdating = False

Lastrow = Sheets("Source").Cells(Rows.Count, "L").End(xlUp).Row
Lastrowa = Sheets("Report").Cells(Rows.Count, "A").End(xlUp).Row + 1

For n = 1 To Lastrow

 If Left(Sheets("Source").Cells(n, 12), 2) = "FD" Then
          Sheets("Report").Range("A" & Lastrowa).Value = Sheets("Source").Cells(n, 13).Value
          Sheets("Report").Range("B" & Lastrowa).Value = Sheets("Source").Cells(n, 3).Value
          Sheets("Report").Range("C" & Lastrowa).Value = Sheets("Source").Cells(n, 4).Value
          Sheets("Report").Range("D" & Lastrowa).Value = Sheets("Source").Cells(n, 15).Value
     End If

Next n
End Sub

But its only giving me the very last results, it should return 107 results, not sure where its getting caught up

mrkambo · 8 Jun 2017 at 20:03

ahh got it, just had to move the Lastrowa inside the if

Code:

Private Sub sortfails_Click()
'This checks if source is loaded
Dim rn As Integer
sheetexists = False
For Each ws In ThisWorkbook.Worksheets
If ws.Name = "Source" Then
sheetexists = True
End If
Next ws
If sheetexists = False Then
MsgBox "Source File Doesn't Exist, Import source file", vbInformation, "test"
End If

'This is the search function

search:
Dim x As Integer
Dim Lastrow As Long
Dim Lastrowa As Long
Dim n As Long

Lastrow = Sheets("Source").Cells(Rows.Count, "L").End(xlUp).Row

For n = 8 To Lastrow

    If Left(Sheets("Source").Cells(n, 12), 2) = "FD" Then
        Lastrowa = Sheets("Report").Cells(Rows.Count, "A").End(xlUp).Row + 1
        Sheets("Report").Range("A" & Lastrowa).Value = Sheets("Source").Cells(n, 13).Value
        Sheets("Report").Range("B" & Lastrowa).Value = Sheets("Source").Cells(n, 3).Value
        Sheets("Report").Range("C" & Lastrowa).Value = Sheets("Source").Cells(n, 4).Value
        Sheets("Report").Range("D" & Lastrowa).Value = Sheets("Source").Cells(n, 15).Value
    End If
    Next n
End Sub

Any idea after this how i can remove duplicate entries, so what ever is B, if its also in the say the next 4 or 5 rows, it just removes all the rows except one