Converting Excel Formula Into VBA

[Excel_VBA_User]

Hi Everyone,

I'm working with an ever-growing spreadsheet that I'm using to parse weather data strings from the internet. At the moment the spreadsheet contains 100,000 lines of data and 50+ columns, each with Excel formulas like the following to extract key bits of data:



=IFERROR(IF(LEFT(J3,3)="---",TRIM(MID(J3,FIND(CHAR(1),SUBSTITUTE(J3," ",CHAR(1),2)),LEN(J3))),TRIM(MID(J3,FIND(CHAR(1),SUBSTITUTE(J3," ",CHAR(1),3)),LEN(J3)))),"")



This Excel formula looks at a data string cell J3 (down to J100,000) and removes a leading portion. The resulting substring is printed in cell K3. Here are two sample strings that I'm working with:



10Oct15 NASA1 2 Miami 23 23.5 25 26 27 28 28 27.9 27.8 29 .....

--- NASA15 12 Tampa 24 24 24 25 25.1 26.2 27 27.1 27.1 27.2 .....



The Excel formula generates the following desired results:



Miami 23 23.5 25 26 27 28 28 27.9 27.8 29 .....

Tampa 24 24 24 25 25.1 26.2 27 27.1 27.1 27.2 .....



Because each cell in my spreadsheet contains a similar Excel formula, the file is 100mb+ and very unstable. I have tried various techniques to reduce the file size but it keeps ballooning back up to 100mb+. I looked into VBA options and started by recording the following macro:

Sub TestRecording()

'

Dim rowNum As Integer

Set UsedRng = ActiveSheet.UsedRange

LastRow = UsedRng(UsedRng.Cells.Count).Row

Range("K3").Select

    Do Until ActiveCell.Row = LastRow + 1

            ActiveCell.FormulaR1C1 = "=IFERROR(IF(LEFT(RC[-1],3)=""---"",TRIM(MID(RC[-1],FIND(CHAR(1),SUBSTITUTE(RC[-1],"" "",CHAR(1),2)),LEN(RC[-1]))),TRIM(MID(RC[-1],FIND(CHAR(1),SUBSTITUTE(RC[-1],"" "",CHAR(1),3)),LEN(RC[-1])))),"""")"

        ActiveCell.Offset(1, 0).Select

    Loop





End Sub

This code produces the correct result, but it writes the Excel formula into the cell. Hence, the ballooning file size issue remains. I'm looking for help/guidance to convert the above Excel formula into a VBA functions with nested IFs etc. that just prints the result in corresponding cell in column J. Once I have a better understanding of how to rewrite the Excel formula as a VBA, I'll be able to tackle the remaining formulas in my spreadsheet. Many thanks in advance for your help!!

 

[Excel_VBA_User]

Perpa, many thanks for the amazing VBA solution! Cheers, David.

 

[Perpa]

Here's a slightly different way to loop and build the formula:

Excel 2010
	A	B
1	Number	Formula
2	2
3	3
4	4
5	5
6	6
7	7
8	8
9	9
10	10
11	11
12	12
13	13
14	14
15	15
16	16
17	17
18	18
19	19
20	20
Sheet3

Sub formulaplace()
Dim i%, lr%, QQQ As String
lr = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lr
QQQ = Cells(i, 1).Address(0, 0)
Cells(i, 2).Value = "=IFERROR(IF(LEFT(" & QQQ & ",3)=""---"",TRIM(MID(" & QQQ & ",FIND(CHAR(1),SUBSTITUTE(" & QQQ & ","" "",CHAR(1),2)),LEN(" & QQQ & "))),TRIM(MID(" & QQQ & ",FIND(CHAR(1),SUBSTITUTE(" & QQQ & ","" "",CHAR(1),3)),LEN(" & QQQ & ")))),"""")"
Next
End Sub

Excel 2010
	A	B
1	Number	Formula
2	2
3	3
4	4
5	5
6	6
7	7
8	8
9	9
10	10
11	11
12	12
13	13
14	14
15	15
16	16
17	17
18	18
19	19
20	20
Sheet3

Cell Formulas
Range	Formula
B2	=IFERROR(IF(LEFT(A2,3)="---",TRIM(MID(A2,FIND(CHAR(1),SUBSTITUTE(A2," ",CHAR(1),2)),LEN(A2))),TRIM(MID(A2,FIND(CHAR(1),SUBSTITUTE(A2," ",CHAR(1),3)),LEN(A2)))),"")

If you change the third to last line to:

Cells(i, 2).Value = evaluate("=IFERROR(IF(LEFT(" & QQQ & ",3)=""---"",TRIM(MID(" & QQQ & ",FIND(CHAR(1),SUBSTITUTE(" & QQQ & ","" "",CHAR(1),2)),LEN(" & QQQ & "))),TRIM(MID(" & QQQ & ",FIND(CHAR(1),SUBSTITUTE(" & QQQ & ","" "",CHAR(1),3)),LEN(" & QQQ & ")))),"""")")

you'll get the result instead of the formula.

sheetspread,
Nice one!

If you change the third to last line to:

Cells(i, 2).Value = evaluate("=IFERROR(IF(LEFT(" & QQQ & ",3)=""---"",TRIM(MID(" & QQQ & ",FIND(CHAR(1),SUBSTITUTE(" & QQQ & ","" "",CHAR(1),2)),LEN(" & QQQ & "))),TRIM(MID(" & QQQ & ",FIND(CHAR(1),SUBSTITUTE(" & QQQ & ","" "",CHAR(1),3)),LEN(" & QQQ & ")))),"""")")

you'll get the result instead of the formula.

Perpa

 

[sheetspread]

Fantastic! Sheetspread, your solution worked perfectly.

sheetspread,
Nice one!

Perpa