Help with VBA macro

[Allison1995]

Hello everyone!

First of all I have to say is a great forum! found really interesting stuff that helped me with my VBA skills.

Secondly, I was wondering if someone could help me with a simple macro that I couldn't find online and is driving me crazy.

What I have is a table with different times on the first column starting at A5 :e.g 0.01hr, 0.023 hr, 0.011 hr, 0.18 hr, 0.205 hr etc. and different values in the rest.

This is really big matrix that goes up to 180 hours, what I'm trying to do is ;

-Look at the times from A5 to the last number of the column.
-Choose a time interval e.g. every 10 min.
-Select the row that are closer to that time interval (this will be, close to 0.1, 0.2 0.3hr .....). This will have to compare the previous and next number between 10, for example 9.1 and 10.2 . Whatever number is closer to 10, is the row I want to select.
-Move to the next interval (0.2hr min) and do the same until it has finish to the last interval (e.g. 200hr)
-Copy that rows closes to my time intervals and paste them into Sheet4.

I don't think I'm doing this the easy way. What I try is creating a column with my times that I want to select. e.g. 10, 20, 30, 40 .... ("D"). Then used the Match function to select the row with the time closes to the one I set, and them used INDEX, to see the value, copy it and paste it.

Sub CreateSheet()
'this creates the new sheet4 where the data will be pasted.

With ThisWorkbook
.Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = "Sheet4"
End With

Worksheets("Sheet2").Range("G6:G7000").Formula = "=(=MATCH(MIN(ABS(A$1:A$36-D4)),ABS(A$1:A$36-D4),0))"

Worksheets("Sheet2").Range("G6:G7000").Formula = "=(=INDEX(B$1:C$36,MATCH(MIN(ABS(A$1:A$36-D1)),ABS(A$1:A$36-D1),0),0))"
Worksheets("Sheet2").Range("G6:G7000").Formula = "=(=INDEX(B$1:C$36,MATCH(MIN(ABS(A$1:A$36-D1)),ABS(A$1:A$36-D1),0),0))"

Sheets("Sheet2").Rows("5").EntireRow.Copy
Sheets("Sheet4").Rows("2").PasteSpecial xlPasteValues

End Sub

Will be great if anyone could give me a hand or give me some guidance .

Thank you in advance, much appreciated it

(P.S. I'm new to the forum and couldn't find it anywhere)

 

[Allison1995]

Sure, just uploaded into the dropbox.

Let me know if it stills too big and I will reduce the size.

Thanks

 

[Peter_SSs]

The sample files are all *.xlsx files. That is, none of them contain macros, so where does the code from post 5 actually reside?

I assumed that the code would be in the ThisWorkbook file so I added the code from post 5 (with the amendment mentioned below) and saved it as ThisWorkbook.xlsm

The code amendment was the one you mentioned earlier ..

I added a line with Worksheets("Sheet2").Activate

..about ensuring that Sheet2 was active before the code I supplied was run. I placed it as shown here

  Const Interval As Double = 0.1
  Worksheets("Sheet2").Activate
  With Range("A4", Range("A" & Rows.Count).End(xlUp).Offset(1)).Resize(, Cells(4, Columns.Count).End(xlToLeft).Column)

With no other workbooks open I ran the code and it ran without error and successfully created Sheets 2, 3 & 4 and transferred the headings and 200 other rows from the 1,173 rows from Sheet2.

Have you run it with those sample files that you provided for me to test?


BTW, to get the first data row also copied (as requested in post 4) just add this line where shown.

b(1, 1) = 1
b(2, 1) = 1
dTest = Interval