VBA Code to extract numbers and values

[howard]

I have account numbers (6 digits) in Col D and values in Col E

I would like VBA code to extract the number directly above 125915 and 125925 as well as these numbers as well as the corresponding value in Col E and place this in sheet "Extracted Data"

I have +- 5000 rows data

See sample data below

Excel 2012
	D	E
1	987122	650
2	197150	470
3	125915	981.15
4	547850	654.25
5	667800	985.25
6	114105	495.35
7	125925	775.65
8
Sheet1

 

[NeonRedSharpie]

Sub extractNums()

Dim nextRow As Long
Dim endRow As Long


Dim dSheet As Worksheet
Dim eSheet As Worksheet


Set dSheet = ActiveWorkbook.Sheets(1) 'CHANGE ME PLEASE
Set eSheet = ActiveWorkbook.Sheets("Extracted Data")


endRow = dSheet.Cells(Rows.Count, "D").End(xlUp).Row
nextRow = eSheet.Cells(Rows.Count, "D").End(xlUp).Row


For x = 1 To endRow
    Select Case Cells(x, 4)
    Case 125915, 125925
        eSheet.Cells(nextRow, 4) = dSheet.Cells(x - 1, 4)
        eSheet.Cells(nextRow, 5) = dSheet.Cells(x - 1, 5)
        
        nextRow = nextRow + 1
    Case Else
        ' Do nothing
        
    End Select
Next x




End Sub

This assumes you want to put your data into D and E on "Extracted Data"

 

[Rick Rothstein]

Assuming the values in Column A are constants (not formulas) and that the "Extracted Data" sheet already exists, here is another macro you can try...

Sub ExtractDataFor125915and125925()
  Dim R As Long, Cell As Range
  Columns("A").Replace "125915", "=125915", xlWhole
  Columns("A").Replace "125925", "=125925", xlWhole
  R = Sheets("Extracted Data").Cells(Rows.Count, "A").End(xlUp).Row - 1
  For Each Cell In Columns("A").SpecialCells(xlFormulas)
    R = R + 2
    Sheets("Extracted Data").Cells(R, "A").Resize(2, 2) = Cell.Offset(-1).Resize(2, 2).Value
  Next
  Columns("A").Replace "=", "", xlPart
End Sub

 

[howard]

Hi Guys

Thanks for the help, much appreciated

 

[howard]

Hi Rick

Thanks very much for your help. I have adapted yoiur code by adding an extract account number to extract, but when extracted , there are blank rows in between

I tried to try to eliminate this from happening but don't know where to amend this in the code

Excel Workbook
	A	B
1	112300	-101168
2	125925	-14163.5
3
4	121100	115331.6
5	125910	25544
6
7	113350	101168.1
8	125915	14163.53
9
Extracted Data

 

[Rick Rothstein]

Hi Rick

Thanks very much for your help. I have adapted yoiur code by adding an extract account number to extract, but when extracted , there are blank rows in between

I tried to try to eliminate this from happening but don't know where to amend this in the code

I presume you mean an extra account number above the one you currently retrieve...

Sub ExtractDataFor125915and125925()
  Dim R As Long, Cell As Range
  Columns("A").Replace "125915", "=125915", xlWhole
  Columns("A").Replace "125925", "=125925", xlWhole
  R = Sheets("Extracted Data").Cells(Rows.Count, "A").End(xlUp).Row - 1
  For Each Cell In Columns("A").SpecialCells(xlFormulas)
    R = R + [COLOR=#0000ff][B]3[/B][/COLOR]
    Sheets("Extracted Data").Cells(R[COLOR=#ff0000][B] - 1[/B][/COLOR], "A").Resize([COLOR=#0000ff][B]3[/B][/COLOR], 2) = Cell.Offset(-[COLOR=#0000ff][B]2[/B][/COLOR]).Resize([COLOR=#0000ff][B]3[/B][/COLOR], 2).Value
  Next
  Columns("A").Replace "=", "", xlPart
End Sub

I highlighted the values that needed to be changed in blue and one value that needed to be added in red so you could see what needed to be changed just in case you wanted to change it again. A note about the red one... it controls the row on the "Extracted Data" sheet where the output starts (currently set to Row 2 which assumes you will put header in Row 1... if no headers will be used, then change the -1 to -2).

 

[howard]

Hi Rick

Is there any way to speed this up. I have +- 40000 rows of data?

 

[snb_]

yes:

Sub M_snb()
  sn = Sheet1.Cells(1).CurrentRegion.Resize(, 2)
  
  For j = 1 To UBound(sn)
    If InStr("|125915|125925|", "|" & sn(j, 1) & "|") > 0 Then c00 = c00 & "|" & j - 1 & "|" & j
  Next
  
  sp = Application.Index(sn, Application.Transpose(Split(Mid(c00, 2), "|")), [transpose(row(1:2))])
  
  Cells(1, 10).Resize(UBound(sp), UBound(sp, 2)) = sp
End Sub

or

Sub M_snb()
  sn = Sheet1.Cells(1).CurrentRegion.Resize(, 2)
  
  With CreateObject("scripting.dictionary")
    For j = 1 To UBound(sn)
      If InStr("|125915|125925|", "|" & sn(j, 1) & "|") > 0 Then
         .Item(.Count) = Array(sn(j - 1, 1), sn(j - 1, 2))
         .Item(.Count) = Array(sn(j, 1), sn(j, 2))
      End If
    Next
  
    Sheet1.Cells(1, 10).Resize(.Count, UBound(sn, 2)) = Application.Index(.items, 0, 0)
  End With
End Sub

 

[howard]

Thanks for the help. I get type mismatch and the following code is highlighted

 sp = Application.Index(sn, Application.Transpose(Split(Mid(c00, 2), "|")), [transpose(row(1:2))])

 

[snb_]

My suggestions take the values in columns A & B.
Adapt the code or adapt the worksheet if desired.