CODEWITHSUNDEEP
excelvba
Christopher Rogers
Christopher Rogers

Reputation: 25

Convert Feet to meters in excel with macro for entire column

I am no programmer I am an avionics tech trying to manipulate data from our jets. One I have made a macro that eliminates all unnecessary columns, and adds columns and values to it so that it displays as a kml correctly. However, I cannot find a way to convert feet to meters in the macro for thousands of cells.

Sub sbVBS_To_Delete_Specific_Multiple_Columns()
Sheets("GRT Flight Data    Log_raw").Range("A:B,H:I,K:L,P:P,AB:AH,AK:AN,AQ:AQ,AT:AT,AZ:BJ").EntireColumn.Delete

Columns("G:G").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

Range("G1").Value = "AppendDataColumnsToDescription"

Range("G2:G363").Value = "Yes"

Range("F1").Value = "IconAltitude"

Columns("H:H").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

Range("H1").Value = "IconAltitudeMode"

Range("H2:H363").Value = "MSL"

Columns("I:I").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

Range("I1").Value = "Icon"

Range("I2:I363").Value = "222"

Columns("J:J").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

Range("J1").Value = "IconHeading"

Range("J2:J363").Value = "line-0"

Columns("K:K").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

Range("K1").Value = "IconScale"

Range("K2:K363").Value = ".5"

Columns("L:L").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

Range("L1").Value = "IconLineColor"

Range("L2:L363").Value = "Cyan"

Columns("M:M").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

Range("M1").Value = "LineStringColor"

Range("M2:M363").Value = "Lime"

End Sub

Upvotes: 0

Views: 1401

Answers (2)

John Alexiou
John Alexiou

Reputation: 29264

To take all values from a column, convert them and write the results in a different column follow the example below

Sub ConvertFtToMetersExample(ByRef r_in as Range, ByRef r_out as Range)

    Dim nr as long, i as Long
    'Count the rows on the input range
    nr = r_in.Rows.Count
    'Set output range to be the same size as the input range
    Set r_out = r_out.Resize(nr,1)
    'Set temporary array storage in memory
    Dim values() as Variant
    'Read all values in one swoop
    values = r_in.Value2
    'Go through all of the and transform them.
    'This is a fast operation as it is done in memory and away from the GUI
    For i=1 to nr
        values(i,1) = (12#*0.0254)*values(i,1)
    Next i
    'Export out all the values to the r_out range
    r_out.Value2 = values

Exit Sub

Edit 1

You can also use the CONVERT() worksheet function

values(i,1) = WorksheetFunctions.Convert(values(i,1), "ft", "m")

Upvotes: 0

VBA Pete
VBA Pete

Reputation: 2666

You can convert Feet to Kilometers using the CONVERT function:

=CONVERT(A2,"ft","km")

enter image description here

In VBA you can call it as a worksheet function:

Application.WorksheetFunction.Convert(.Value, "ft", "km")

In order to include this in your code, add the following lines to your code:

Dim lastrow as long

lastrow = .Cells(.Rows.Count, "F").End(xlUp).Row

For x=2 to lastrow
    Cells(x,6).value = Application.WorksheetFunction.Convert(Cells(x,6).value, "ft", "km")
Next x

This is how I would change your code, if you want row 363 to be your last row. Note that xLng can be updated to any number if the last row needs to be something other than 363:

Sub sbVBS_To_Delete_Specific_Multiple_Columns()

Dim xLng As Long

xLng = 363

Sheets("GRT Flight Data    Log_raw").Range("A:B,H:I,K:L,P:P,AB:AH,AK:AN,AQ:AQ,AT:AT,AZ:BJ").EntireColumn.Delete

Columns("G:G").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("G1").Value = "AppendDataColumnsToDescription"
Range("G2:G" & xLng).Value = "Yes"

Range("F1").Value = "IconAltitude"
For x = 2 To xLng
    Cells(x, 6).Value = Application.WorksheetFunction.Convert(Cells(x, 6).Value, "ft", "km")
Next x

Columns("H:H").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("H1").Value = "IconAltitudeMode"
Range("H2:H" & xLng).Value = "MSL"

Columns("I:I").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("I1").Value = "Icon"
Range("I2:I" & xLng).Value = "222"

Columns("J:J").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("J1").Value = "IconHeading"
Range("J2:J" & xLng).Value = "line-0"

Columns("K:K").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("K1").Value = "IconScale"
Range("K2:K" & xLng).Value = ".5"

Columns("L:L").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("L1").Value = "IconLineColor"
Range("L2:L" & xLng).Value = "Cyan"

Columns("M:M").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("M1").Value = "LineStringColor"
Range("M2:M" & xLng).Value = "Lime"

End Sub

Upvotes: 4

Related Questions