Hi All
Awhile back, MacroMike help me setup a vba code to find values which were separated by a certain value, thus there would be pairs of numbers sought after. What occured was that the first value is bolded, followed by the second not bolded, this pair would be separated by 75. Now I want to apply the same code, but instead of copying just the two cells which were separated to someone on the current sheet, I would like it to copy the entire row (as there is more data associated with it now) with the same bold/not bolded pairing to a new sheet, called "Numbers". I would imgine it be straight forward, yet I am very new to this and still tinkering. If anyone can help, that would be fantastic! Thanks so much for reading.
Heres the code:
Sub FindSetDifference2()
'written for user "DazedandConfused" by "macromike"
'November 17, 2006
'----DECLARATIONS
Dim a As Integer, b As Integer, c As Integer, d As Integer, e As Integer 'counters for main loop
Dim x As Integer, y As Integer 'counters for the 2nd loop to copy up and over
Dim FirstRow As Integer, LastRow As Integer, DataColumn As Integer, OutputColumn As Integer
Dim ValueOne As Single, ValueTwo As Single, ValueThree As Single, ValueFour As Single, ValueFive As Single
'allows them to contain decimals
'---SETUP - USER CAN MODIFY
DataColumn = 1 '1 = Column A, adjust as necessary
OutputColumn = 2 '2 = Column B, adjust as necessary
FirstRow = 2 '2 = Row 2, adjust as necessary
'below finds the last row of data, whether its ten rows or a 100 rows
LastRow = Cells(Rows.Count, DataColumn).End(xlUp).Row
'--MAIN LOGICAL LOOP
x = FirstRow 'sets an initial condition for this counter before loop below
For a = FirstRow To LastRow
'matchesfound = 0
ValueOne = Cells(a, DataColumn).Value
b = a + 1
ValueTwo = Cells(b, DataColumn).Value
c = a + 2
ValueThree = Cells(c, DataColumn).Value
d = a + 3
ValueFour = Cells(d, DataColumn).Value
e = a + 4
ValueFive = Cells(e, DataColumn).Value
'checks difference between 1st and 2nd values in succession
If (ValueTwo - ValueOne >= 74) And (ValueTwo - ValueOne <= 76) Then
'copy and past values over to OutputColumn
Cells(x, OutputColumn).Value = ValueOne
Cells(x, OutputColumn).Select
Selection.Font.Bold = True
y = x + 1
Cells(y, OutputColumn).Value = ValueTwo
x = x + 2 'increments it for next time a match is found including below
matchesfound = 1
End If
'checks difference between 1st and 3rd values in succession
If (ValueThree - ValueOne >= 74) And (ValueThree - ValueOne <= 76) Then
'copy and past values over to OutputColumn
Cells(x, OutputColumn).Value = ValueOne
Cells(x, OutputColumn).Select
Selection.Font.Bold = True
y = x + 1
Cells(y, OutputColumn).Value = ValueThree
x = x + 2 'increments it for next time a match is found including below
matchesfound = 1 + matchesfound
End If
'checks difference between 1st and 4th values in succession
If (ValueFour - ValueOne >= 74) And (ValueFour - ValueOne <= 76) Then
'copy and past values over to OutputColumn
Cells(x, OutputColumn).Value = ValueOne
Cells(x, OutputColumn).Select
Selection.Font.Bold = True
y = x + 1
Cells(y, OutputColumn).Value = ValueFour
x = x + 2 'increments it for next time a match is found including below
matchesfound = 1 + matchesfound
End If
'checks difference between 1st and 5th values in succession
If (ValueFive - ValueOne >= 74) And (ValueFive - ValueOne <= 76) Then
'copy and past values over to OutputColumn
Cells(x, OutputColumn).Value = ValueOne
Cells(x, OutputColumn).Select
Selection.Font.Bold = True
y = x + 1
Cells(y, OutputColumn).Value = ValueFive
x = x + 2 'increments it for next time a match is found including below
matchesfound = 1 + matchesfound
End If
'a = matchesfound - 1
Next 'increments a by one
End Sub
Display More
Thanks for everyone's help once again.
Justin