Related
i am very new to VBA or programmin in general.
Nevertheless, I need to create a code for exporting a csv file.
My issue is that I have several rows with varying lenght in my file.
The file looks as following:
3,6,8
3,9,4,7,8
1
2,4
7,9,4,5,6,8,1
3
My codes gives me:
"3","6","8","","","",""
"3","9","4","7","8","",""
"1","","","","","",""
"2","4","","","","",""
"7","9","4","5","6","8","1"
"3","","","","","",""
I need:
"3","6","8"
"3","9","4","7","8"
"1"
"2","4"
"7","9","4","5","6","8","1"
"3"
Can anyone please help me?
Sub CIF_Katalog_2()
Dim i As Long, lngZeile As Long
Dim myCSVFileName As String
Dim myWB As Workbook
Set myWB = ThisWorkbook
myCSVFileName = myWB.Path & "\" & "CSV Katalog Export_" & VBA.Format(VBA.Now, "dd-MMM-yyyy hh-mm") & ".csv"
lngZeile = Range("A" & Rows.Count).End(xlUp).Row
Open myCSVFileName For Output As #1
For i = 1 To lngZeile
If i = 1 Then
Print #1, Chr(34) & Cells(i, 1).Value & Chr(34)
ElseIf i = 2 Then
Print #1, Chr(34) & Cells(i, 1).Value & Chr(34) & "," & Chr(34) & Cells(i, 2).Value & Chr(34)
Else
Print #1, Chr(34) & Cells(i, 1).Value & Chr(34) & "," & Chr(34) & Cells(i, 2).Value & Chr(34) & "," & Chr(34) & Cells(i, 3).Value & Chr(34) & "," & Chr(34) & Cells(i, 4).Value & Chr(34) & "," & Chr(34) & Cells(i, 5).Value & Chr(34) & "," & Chr(34) & Cells(i, 6).Value & Chr(34) & "," & Chr(34) & Cells(i, 7).Value & Chr(34) & "," & Chr(34) & Cells(i, 8).Value & Chr(34) & "," & Chr(34) & Cells(i, 9).Value & Chr(34) & "," & Chr(34) & Cells(i, 10).Value & Chr(34) & "," & Chr(34) & Cells(i, 11).Value & Chr(34) & "," & Chr(34) & Cells(i, 12).Value & Chr(34) & "," & Chr(34) & Cells(i, 13).Value _
& Chr(34) & "," & Chr(34) & Cells(i, 14).Value & Chr(34) & "," & Chr(34) & Cells(i, 15).Value & Chr(34) & "," & Chr(34) & Cells(i, 16).Value & Chr(34) & "," & Chr(34) & Cells(i, 17).Value & Chr(34) & "," & Chr(34) & Cells(i, 18).Value & Chr(34) & "," & Chr(34) & Cells(i, 19).Value & Chr(34) & "," & Chr(34) & Cells(i, 20).Value & Chr(34) & _
"," & Chr(34) & Cells(i, 21).Value & Chr(34) & "," & Chr(34) & Cells(i, 22).Value & Chr(34) & "," & Chr(34) & Cells(i, 23).Value & Chr(34) & "," & Cells(i, 24).Value & Chr(34) & "," & Chr(34) & Cells(i, 25).Value & Chr(34) & "," & Chr(34) & Cells(i, 26).Value & Chr(34) & "," & Chr(34) & Cells(i, 27).Value & Chr(34) & "," & Chr(34) & Cells(i, 28).Value & Chr(34) & "," & Chr(34) & Cells(i, 29).Value & Chr(34) & "," & Cells(i, 30).Value & "," & Chr(34) & Cells(i, 31).Value & Chr(34) & "," & Chr(34) & Cells(i, 32).Value & Chr(34) & "," & Chr(34) & Cells(i, 33).Value & Chr(34) & "," & Chr(34) & Cells(i, 34).Value & Chr(34) & "," & Chr(34) & Cells(i, 35).Value & Chr(34)
End If
Next i
Close #1
MsgBox "Erledigt"
End Sub
Give this a try... just reusing your code:
Sub CIF_Katalog_2()
Dim i As Long, x As Long, lngZeile As Long
Dim myCSVFileName As String, strTemp As String
Dim myWB As Workbook: Set myWB = ThisWorkbook
myCSVFileName = myWB.Path & "\" & "CSV Katalog Export_" & VBA.Format(VBA.Now, "dd-MMM-yyyy hh-mm") & ".csv"
lngZeile = Range("A" & Rows.Count).End(xlUp).Row
Open myCSVFileName For Output As #1
For i = 1 To lngZeile
For x = 1 To 35
If Cells(i, x) <> "" Then
strTemp = strTemp & Chr(34) & Cells(i, x).Value & Chr(34) & ","
End If
Next x
Print #1, Left(strTemp, Len(strTemp) - 1)
strTemp = ""
Next i
Close #1
MsgBox "Erledigt"
End Sub
EndRowH = ActiveSheet.Range("H65536").End(xlUp).Row
ActiveSheet.Range("H1").Formula = "=SUMIFS(H3:H" & EndRowH & ", C3:C" & EndRowH & ", "">=" & lngStart & """)"
I Have a criteria on the C column where it has to be greater than the lngStart Value.
The code is working till here.. But I have to add an extra criteria where the sumif needs to be done only if there is blank value in the column I
Dim Blank As Long
Blank = ""
ActiveSheet.Range("H1").Formula = "=SUMIFS(H3:H" & EndRowH & ", C3:C" & EndRowH & ", "">=" & lngStart & "",I3:I" & EndRowH & ", ""!=" & Blank & "" ")"
When working with complex strings you want to put as a Formula, you might want to use an "helper" string, in the code below I use FormulaString, so when you run the Debug.Print line, you can see if the formula string is valid.
Also, and it's only my preference, to get the " inside, I prefer to use Chr(34).
Code
Dim FormulaString As String
FormulaString = "=SUMIFS(H3:H" & EndRowH & ", C3:C" & EndRowH & "," & Chr(34) & ">=" & lngStart & Chr(34) & ",I3:I" & EndRowH & "," & Chr(34) & "<>" & Chr(34) & ")"
Debug.Print FormulaString
ActiveSheet.Range("H1").Formula = FormulaString
Running this code, you will get in the immediate window the following formula:
=SUMIFS(H3:H10, C3:C10,">=5",I3:I10,"<>")
I'd go this way
ActiveSheet.Range("H1").Formula = "=SUMIFS(H3:H" & EndRowH & ", C3:C" & EndRowH & ", concatenate("">=""," & lngStart & "),I3:I" & EndRowH & ", ""="")"
First of all, I have tried to look at all the other examples of adding a formula using VBA, and I think I have tried to apply all the answers in this code
Sub AddFormulas(SheetName As String)
Dim i As Integer
'Switch worksheet
Set Wksht = ThisWorkbook.Worksheets(SheetName)
Wksht.Activate
Application.Calculation = xlCalculationManual
i = 2
While Not IsEmpty(Cells(i, 1))
Wksht.Cells(i, 18).Formula = "=IFERROR(VLOOKUP(A" & i & ";" & Wksht.Cells(1, 18) & "!$A:$A;1;FALSE);" & Chr(34) & "MISSING" & Chr(34) & ")"
i = i + 1
Wend
Application.Calculation = xlCalculationAutomatic
End Sub
But still, it gives me this anoying error, that I can't interpret
If I change my line to
Wksht.Cells(i, 18) = "'IFERROR(VLOOKUP(A" & i & ";" & Wksht.Cells(1, 18) & "!$A:$A;1;FALSE);" & Chr(34) & "MISSING" & Chr(34) & ")"
Then I get no error, and the correct formula is added, although as a text string
What is wrong, since it would not add what to me looks like a valid formula?
//V
The Formula property requires formulas to be written in English, i.e. English function names (not an issue here) and commas as separators rather than semi-colons.
So your statement should be:
Wksht.Cells(i, 18).Formula = "=IFERROR(VLOOKUP(A" & i & "," & Wksht.Cells(1, 18) & "!$A:$A,1,FALSE)," & Chr(34) & "MISSING" & Chr(34) & ")"
If you don't mind having "portability" issues, you could also use the FormulaLocal property, i.e.
Wksht.Cells(i, 18).FormulaLocal = "=IFERROR(VLOOKUP(A" & i & ";" & Wksht.Cells(1, 18) & "!$A:$A;1;FALSE);" & Chr(34) & "MISSING" & Chr(34) & ")"
Write the formula as it should be in Excel, select it and run the following code:
Public Sub PrintMeUsefulFormula()
Dim strFormula As String
Dim strParenth As String
strParenth = """"
strFormula = Selection.Formula
strFormula = Replace(strFormula, """", """""")
strFormula = strParenth & strFormula & strParenth
Debug.Print strFormula
End Sub
It should print it as it should be.
I believe your code is giving error becouse of this Wksht.Cells(1, 18) part of line in this row Wksht.Cells(i, 18).Formula = "=IFERROR(VLOOKUP(A" & i & ";" & Wksht.Cells(1, 18) & "!$A:$A;1;FALSE);" & Chr(34) & "MISSING" & Chr(34) & ")". Make sure that Wksht.Cells(1, 18) really contains name of worksheet your are trying to address. If this cell is blank, you will receive previously mentioned error.
I want to implement the following formula in to Excel cells
IF(OR(D12>0,C13=""),"",MAX(SUM($C$12:C13)-$D$9,0))
(once formula is applied I should get following result (formula implemented manually):
so i wrote simple macro as below , but unable to implement formula , formula retuns value as "true"
Sub adjustoldbills()
lastRow_sht4 = Sheet4.Range("A" & Rows.Count).End(xlUp).Row
Sheet4.Cells(12, 11) = ""
For i = 1 To lastRow_sht4 - 10
If Sheet4.Cells(11 + i, 1) <> "" Then
'=MAX(SUM($C$12:C15)-$D$9,0)
Sheet4.Cells(12, 4).Formula = "=MAX(SUM($C$12:C" & 12 & ")-$D$9,0)"
Sheet4.Cells(11 + i, 4).Formula = "=(if(or(D" & 11 + i > 0 & ",C" & 12 + i & "=" & Chr(34) & Chr(34) & ")," & Chr(34) & Chr(34) & "," & "MAX(SUM($C$12:C" & 12 & i & ")-$D$9,0)"
End If
Next i
End Sub
i am getting wrong result after implemented formula via vba macro as in this image:
how to implement formula and get value as expected.
When trying to convert long formulas to VBA try using a String variable to help you test it.
Dim FormulaStr As String
FormulaStr = "=IF(OR(D" & 11 + i & ">0,C" & 12 + i & "=" & Chr(34) & Chr(34) & ")," & _
Chr(34) & Chr(34) & ",MAX(SUM($C$12:C" & 12 + i & ")-$D$9,0))"
Debug.Print FormulaStr
Then, in the immediate window you will get:
=IF(OR(D12>0,C13=""),"",MAX(SUM($C$12:C13)-$D$9,0))
which is the formula you want to convert to VBA.
Now all you need to do is to add the line below:
Sheet4.Cells(11 + i, 4).Formula = FormulaStr
If you want to skip the String variable, you can just replace your line of
Sheet4.Cells(11 + i, 4).Formula = "=(if(or(D" & 11 + i > 0 & ",C" & 12 + i & "=" & Chr(34) & Chr(34) & ")," & Chr(34) & Chr(34) & "," & "MAX(SUM($C$12:C" & 12 & i & ")-$D$9,0)"
to:
Sheet4.Cells(11 + i, 4).Formula = "=IF(OR(D" & 11 + i & ">0,C" & 12 + i & "=" & Chr(34) & Chr(34) & ")," & Chr(34) & Chr(34) & ",MAX(SUM($C$12:C" & 12 + i & ")-$D$9,0))"
I'd go another way, with no loops and exploiting SpecialCells() method of Range object
Option Explicit
Sub adjustoldbills()
With Sheet4
.Range("D12").FormulaR1C1 = "=MAX(RC[-1]-R9C4,0)"
With .Range("A13", .Cells(.Rows.Count, 1).End(xlUp)).SpecialCells(xlCellTypeConstants)
With .Offset(, 2).SpecialCells(xlCellTypeConstants)
.Offset(, 1).FormulaR1C1 = "=IF(R[-1]C>0,"""",MAX(SUM(R12C[-1]:RC[-1])-R9C4,0))"
With .Areas(.Areas.Count)
.Offset(, 1).Cells(.Rows.Count).Offset(1).FormulaR1C1 = "=IF(R[-1]C>0,"""",MAX(SUM(R12C[-1]:RC[-1])-R9C4,0))"
End With
End With
End With
End With
End Sub
This is part of a much larger macro that has multiple instances of Application.OnTime that work just fine.
My issue with this one below is in WaitForPriceVolume() when it gets to the For Each loop and the If is true, it doesn't go back to the procedure WaitForPriceVolume(). It circles back to all the procedures that were called before, effectively just doing the Exit Sub as if the OnTime didn't exist.
When I strip out just the below code and add fixed values for the global variables being used, the Application.OnTime works. It's only when I plug it back into the bigger macro.
Sub BDP_PriceVolume()
Dim lsStartRange As String
Dim lsEndRange As String
Dim lnStartRow As Long
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Set sht = Worksheets("Variables")
' Use gvList
lsStartRange = "C" & gnStartRow
lnStartRow = gnStartRow + UBound(gvList, 2)
lsEndRange = "C" & lnStartRow
sht.Range(lsStartRange & ":" & lsEndRange).Value = _
"=BDP($A" & gnStartRow & "&Variables!$A$2,Variables!$D$2)"
lsStartRange = "D" & gnStartRow
lsEndRange = "D" & lnStartRow
If Worksheets("Variables").Cells(3, 3).Value <> "" Then
sht.Range(lsStartRange & ":" & lsEndRange).Value = _
"=BDH($A" & gnStartRow & "&Variables!$A$2,Variables!$E$3" & "," & _
"Variables!$B$4,Variables!$C$3," & _
Chr(34) & "BarTp=T" & Chr(34) & "," & _
Chr(34) & "BarSz=40" & Chr(34) & "," & _
Chr(34) & "Dir=V" & Chr(34) & "," & _
Chr(34) & "Dts=H" & Chr(34) & "," & _
Chr(34) & "Sort=A" & Chr(34) & "," & _
Chr(34) & "Quote=C" & Chr(34) & "," & _
Chr(34) & "UseDPDF=Y" & Chr(34) & ")"
Else
sht.Range(lsStartRange & ":" & lsEndRange).Value = _
"=BDP($A" & gnStartRow & "&Variables!$A$2,Variables!$E$2)"
End If
sht.Range("C" & gnStartRow & ":" & lsEndRange).Select
Application.Run "RefreshCurrentSelection"
Application.OnTime Now + TimeValue("00:00:03"), "WaitForPriceVolume"
End Sub
Private Sub WaitForPriceVolume()
Dim rng As Range
Set rng = sht.Range("C" & gnStartRow & ":D" & fnLastRow(sht, "A"))
Dim cell As Range
Application.ScreenUpdating = True
For Each cell In rng
If cell.Value = "#N/A Requesting Data..." Then
Application.OnTime Now + TimeValue("00:00:03"), "WaitForPriceVolume"
Exit Sub
End If
Next cell
Call DoneWaitForPriceVolume
End Sub
Own stupidity. All the other instances of OnTime came at the end of the code, so the macro had nothing left to do until the OnTime triggered and I forced everything to circle back to the main macro. I hadn't done that in this case. Problem solved. This haunted me for a week