Slide over and fill down

Golfball

New Member
Joined
Mar 29, 2002
Messages
15
What is the best way to tackle this? Hoping the image conveys my problem well enough that my words and ignorance won't get in the way. Simply trying to create a CSV for borehole data. 1st number is the borehole number. It needs to be copied down for each layer of the borehole. 2nd and 3rd are the coordinates, they also need to go to column B & C for each layer of the borehole....then I need to do it again for the next borehole. Hoping to do this with VBA.

Thank you for your help!

QG0If.png
 

Excel Facts

What is =ROMAN(40) in Excel?
The Roman numeral for 40 is XL. Bill "MrExcel" Jelen's 40th book was called MrExcel XL.
Does this do what you want?

Sub Sort_Bore_Data()
'
Range("E65000").Select
Selection.End(xlUp).Select
LastLine = ActiveCell.Row

i = 1
Do While (i < LastLine)
If (Cells(i, 5).Value = "Latitude") Then
Cells(i + 2, 1).Value = Cells(i - 1, 5).Value
Cells(i + 2, 2).Value = Cells(i, 6).Value
Cells(i + 2, 3).Value = Cells(i + 1, 6).Value
Range(Rows(i - 1), Rows(i + 1)).Delete shift:=xlUp
LastLine = LastLine - 3
i = 0
End If
i = i + 1
Loop
End Sub
 
Upvote 0
That is great. It's a step closer to what I need. I need those values filled down for each layer of the borehole. So A:4 through A:11 would be 10, B:4 through B:11 would be the lat and C:4 through C:11 would be the long. I realize my words or picture didn't convey that very well...but I'm a step closer to what I need, and the fill down should be simpler for me to wrap my head around. Thank you.
 
Upvote 0
So you mean this?

Sub Sort_Bore_Data()
'
Range("E65000").Select
Selection.End(xlUp).Select
LastLine = ActiveCell.Row

i = 1
Do While (i < LastLine)
If (Cells(i, 5).Value = "Latitude") Then
Range(Cells(i + 2, 1), Cells(i + 10, 1)).Value = Cells(i - 1, 5).Value
Range(Cells(i + 2, 2), Cells(i + 10, 2)).Value = Cells(i, 6).Value
Range(Cells(i + 2, 3), Cells(i + 10, 3)).Value = Cells(i + 1, 6).Value

' Range(Rows(i - 1), Rows(i + 1)).Delete shift:=xlUp
Rows(i - 1).ClearContents
Range(Rows(i), Rows(i + 1)).Delete shift:=xlUp

LastLine = LastLine - 3
i = 0
End If
i = i + 1
Loop
End Sub

I added a space between sets so you can see them but if you don't want that then remove the single quote to the left of line 14 and delete the next two lines.

Regards
 
Upvote 0

Forum statistics

Threads
1,207,260
Messages
6,077,352
Members
446,279
Latest member
hoangquan2310

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top