I need one macro for converting Excel spreadsheet to wiki format and post the same in wiki.
Sample data
Column-1 Column-2 Column-3
A Val1 Val1
B Val2 Val2
C Val3 Val3
Lets say that we want to post the converted table to dummy := https://wiki.com/w/Qc/MyPage
i Managed to develop the below code which almost makes a WikiSyntax.
Select the cell range to convert and run the macro.
Sub SelectionToWiki()
PadConst = "cellpadding=""1"" cellspacing=""1"" border=""1"" style=""width: 100%;"""
result = ""
result = result & " "
For i = 1 To Selection.Rows.Count
For j = 1 To Selection.Columns.Count
Dim cell As Range
Set cell = Selection.Cells(i, j)
cellStr = cell.Value
result = result & Chr(13) & "| " & cellStr
Next
result = result & Chr(13) & "|-" & Chr(13)
Next
result = "{| " & PadConst & result & "|}"
Dim MyDataObj As New DataObject
MyDataObj.SetText result
MyDataObj.PutInClipboard
MsgBox "Wiki table copied to clipboard: " & Chr(13) & Chr(13) & result
End Sub
Enhancements will be much appreciated.
Related
I have a short code about inserting a formula to the cell instead of obtaining values but when I tried to use that with VLOOKUP and/or IFERROR, I get error 1004. I did it with SUB, SUBTOTAL before but couldn't achieved with these functions. If you may help, that would be amazing.
GerçekStok = 0
Set StokBook = ActiveWorkbook
Set BticinoBook = Workbooks("BTICINO.xlsm")
NoS = BticinoBook.Sheets.Count
For k = 1 To NoS
If BticinoBook.Sheets(k).Name = "DRAFT" Then
DNumber = k
Exit For
End If
Next k
TotalRow = BticinoBook.Sheets(DNumber).Cells(Rows.Count, 4).End(xlUp).Row
If GerçekStok = 0 Then
For i = 2 To TotalRow
BticinoBook.Sheets(DNumber).Cells(i, 2) = "=IFERROR(VLOOKUP(D" & i & ";'[" & StokBook.Name & "]Sheet2'!$A:$E;3;FALSE);" & Chr(34) & Chr(48) & Chr(34) & Chr(41)
Next i
Else
For i = 2 TotalRow
BticinoBook.Sheets(DNumber).Cells(i, 2) = "=IFERROR(VLOOKUP(D" & i & ";'[" & StokBook.Name & "]Sheet2'!$A:$E;4;FALSE);" & Chr(34) & Chr(48) & Chr(34) & Chr(41)
Next i
End If
You need to use .Formula to enter a formula into a cell.
Range("B10").Formula = "=SUM(B4:B9)"
If your string contains another string with double quotes, then you need to type the double quote twice, like this:
... whatever... ;FALSE);""0"")"
Using Chr() instead of the typed characters doesn't really fix the issue.
BticinoBook.Sheets(DNumber).Cells(i, 2).formula = "=IFERROR(VLOOKUP(D" & i & ";'[" & StokBook.Name & "]Sheet2'!$A:$E;3;FALSE);""0"")"
Of course, there is no reason to put a zero inside of double quotes, so you could simply use
BticinoBook.Sheets(DNumber).Cells(i, 2).formula = "=IFERROR(VLOOKUP(D" & i & ";'[" & StokBook.Name & "]Sheet2'!$A:$E;3;FALSE);0)"
I have a problem with the date format in the new exported csv file.
If I export a range from an excel file, then the date format is dd/mm/yyyy but i need dd/mm/yyyy hh:nn.
If I changed the format in the original excel file to the right form, then the most values in the csv show the right format except the date-value e.g. 18.08.2021 00:00.
So if the time is 00:00 then only the dd/mm/yyyy format appears at that row and this format is incompatible to the database.
(i opened it in excel and in the editor and it appeared the same problem)
can someone help me?
Dim ws As Worksheet, fd As FileDialog, rngTest As Range, rngExport As Range, fltr As FileDialogFilter
Dim start As Long
start = 2
'Nach jeweiliger Zeit wird Datenreihe (start ab) ausgewählt
If Time < TimeValue("11:15") Then
Do Until Daten.Range("ov" & start) = Date + 1
start = start + 1
Loop
ElseIf Time < TimeValue("11:15") Then
Do Until Daten.Range("ov" & start) = Date + 2
start = start + 1
Loop
Else: start = 2
End If
start = start + 1
'Worksheet auf dem die Daten stehen
Set ws = Worksheets("Daten")
'Zelle die auf Inhalt überprüft werden soll
Set rngTest = ws.Range("ov2")
'Bereich der exportiert wird
Set rngExport = ws.Range("ov" & start & ":ow10000")
' ws.Range("ov" & start & ":ov5000").NumberFormat = "dd/mm/yyyy hh:mm"
If rngTest.Text <> "" Then
Set fd = Application.FileDialog(msoFileDialogSaveAs)
'Filename
fd.InitialFileName = "LG" & " " & Diagramm.Range("a5").Value & " " & "RZ" & " " & Format(Date, "mmmm") & " " & Format(Date, "yyyy") & "_" & "MW" & "_" & "ab" & " " & Daten.Range("ov" & start - 1).Value
' Application.Dialogs(xlDialogSaveAs).Show filenameComplete
With fd
.Title = ""
'Filterindex für CSV-Dateien ermitteln
For i = 1 To .Filters.count
If .Filters(i).Extensions = "*.csv" Then
.FilterIndex = i
Exit For
End If
Next
'Wenn OK geklickt wurde starte Export
If .Show = True Then
ExportRangeAsCSV rngExport, ";", .SelectedItems(1)
End If
End With
End If
End Sub
'Hier werden die Werte in eine CSV-Datei eingefügt und gespeichert
Sub ExportRangeAsCSV(ByVal rng As Range, delim As String, filepath As String)
Dim arr As Variant, line As String, csvContent As String, fso As Object, csvFile As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set csvFile = fso.OpenTextFile(filepath, 2, True)
arr = rng.Value 'Filter
If IsArray(arr) Then
' um die Überschrift im CSV oben einzufügen
Dim col As Range
For Each col In rng.Columns
If Len(line) > 0 Then line = line & delim
line = line & """" & rng.Parent.Cells(1, col.column) & """"
Next
csvContent = line & vbNewLine
'um die Werte ins CSV einzufügen
For r = 1 To UBound(arr, 1)
line = ""
For c = 1 To UBound(arr, 2)
If c < UBound(arr, 2) Then
line = line & """" & arr(r, c) & """" & delim
Else
line = line & """" & arr(r, c) & """"
End If
Next
csvContent = csvContent & line & vbNewLine
Next
csvFile.Write (csvContent)
csvFile.Close
Else
MsgBox "Bereich besteht nur aus einer Zelle!", vbExclamation
End If
Set fso = Nothing
Set csvFile = Nothing
End Sub
The Range("ov").value is the date and Range("ow").value the amount (double)
As you are already writing the CSV-File manually, I would suggest to introduce a function that converts your cell content as a string. You could use this routine for multiple purposes, eg format numbers (decimals, number of digits...), get rid of unwanted characters in as string (eg Newlines, semicolon, quote characers)...
Just to give you an idea:
Function FormatCellValue(v As Variant) As String
If IsDate(v) Then
FormatCellValue = Format(v, "dd.mm.yyyy hh:mm")
ElseIf VarType(v) = vbDecimal Then
FormatCellValue = Format(v, "#####.00")
ElseIf VarType(v) = vbString Then
v = Replace(v, vbCr, " ")
v = Replace(v, vbLf, " ")
v = Replace(v, ";", ",")
v = Replace(v, """", "'")
FormatCellValue = v
Else
FormatCellValue = v
End If
End Function
And in your existing code, simply write
line = line & """" & FormatCellValue(arr(r, c)) & """"
Update
If you want to write only strings with quote and dates (and numbers) without, you could add the quotes in the FormatCell-function: In the Vartype = vbString-branch, write
FormatCellValue = """" & v & """"
and change the call to
line = line & FormatCellValue(arr(r, c))
Excel really sucks at formatting numbers because the internal systems keep the stored value and displayed value separately. So what you see is not what will end up in the file when you save. To force excel to actually apply the formatting to the stored value, I use quotes to turn numbers & dates into strings. Like [A1].formula = "=""" & [A1].Value & """" which would turn a cell containing the number 100.00 into ="100.00" a literal string that excel can't reformat.
For your date format situation, you can do [A1].formula = "=""" & Format([A1].Value, "dd/mm/yyyy hh:nn") & """". Which will force excel to save the cell value in the specified format and ensure the output csv is in that format.
Here is a function that I have used previously to change a 2D array of values into an array of formulas as described above.
Private Function ForceString(ByRef InputArr As Variant) As Variant
Dim OutputArr() As Variant
OutputArr = InputArr
Dim i As Long, j As Long
For i = LBound(OutputArr) To UBound(OutputArr)
For j = LBound(OutputArr, 2) To UBound(OutputArr, 2)
If Len(OutputArr(i, j)) < 255 Then
OutputArr(i, j) = "=""" & OutputArr(i, j) & """"
Else
Dim k As Long, Tmp As String
Tmp = "="
For k = 1 To Len(OutputArr(i, j)) Step 255
Tmp = Tmp & IIf(k <> 1, "&", "") & """" & Mid(OutputArr(i, j), 1, 255) & """"
Next k
OutputArr(i, j) = Tmp
End If
Next j
Next i
ForceString = OutputArr
End Function
The If/Else in the middle is due to the limitation in excel about a literal string inside a formula not being allowed to have more than 255 characters. In those cases, it just has to be split up into multiple strings, but the output value is still the same.
I'm new to VBA and I'm trying to create a macro that will filter a column on one sheet (Rules) based on the cell value in another which contains the unique values on that column. The unique values are separated by " & ":
Example, a cell may contain the following value: 19.1 & 19.2 & 19.2c & 14.3a & 14.3b & 14.3b(1) & 14.3b(2) & 14.3b(3) & 14.3c & 14.3c(1) & 14.3c(2) & 14.7a
Each of these values has a unique row in column C of the Rules sheet and I want to filter the sheet on that column for all these values.
I have tried the following but it doesn't work:
Sub ArrayFilter()
Dim Rules As String
Dim ArrayFilter As String
Dim arr As Variant
'This is the cell with the values
' e.g 19.1 & 19.2 & 19.2c & 14.3a & 14.3b & 14.3b(1) & 14.3b(2) & 14.3b(3) & 14.3c & 14.3c(1) & 14.3c(2) & 14.7a
Rules = ActiveCell.Offset(0, 38).Range("A1").Value
' I'm trying to convert this to a string for the filter crieria
ArrayFilter = Chr(34) & Replace(Rules, " & ", Chr(34) & ", " & Chr(34)) & Chr(34)
'Now I make this an Array
arr = Array(ArrayFilter)
Sheets("2019 Rules Breakdown").Select
Application.Run "RemoveAndReApplyFilters"
Range("C1").Select
ActiveSheet.ListObjects("Table10").Range.AutoFilter Field:=3, Criteria1:=arr, _
Operator:=xlFilterValues
'This fails, when I look at the filter deployed it is using Equals and just has the arr output.
End Sub
Any help would be gratefully welcomed.
Thanks
The way you try obtaining the array is not appropriate. You can check it in this way:
Dim rules As String, ArrayFilter As String, arr
rules = "19.1 & 19.2 & 19.2c & 14.3a & 14.3b & 14.3b(1)"
ArrayFilter = Chr(34) & Replace(rules, " & ", Chr(34) & ", " & Chr(34)) & Chr(34)
arr = Array(ArrayFilter)
Debug.Print Join(arr, "|"), UBound(arr) 'it will return "19.1", "19.2", "19.2c", "14.3a", "14.3b", "14.3b(1)" 0 .
'meaning an array with a single element, the long string...
End Sub
Now, using the next way, for the same string, the array will look like it should:
Sub testArrayFromString()
Dim rules As String, arr1
rules = "19.1 & 19.2 & 19.2c & 14.3a & 14.3b & 14.3b(1)"
arr1 = Split(rules, " & ")
Debug.Print Join(arr1, "|"), Ubound(arr1) '19.1|19.2|19.2c|14.3a|14.3b|14.3b(1) 5
'proving that it is an array with 6 elements (0 based)
'Being in VBE, press `Ctrl + G` to see the result in `Immediate Window`.
End Sub
I have a cell in that contains the following:
=$H$10+1&","&B5+I10&","&(2*$D$2+$E$2)/2
The result of this formula is in this format:
14649,28.25,5.5
I want to use the formula VBA code. I want the number 1 in the $H$10+**1**&" to be the i of the for loop and the I10 in "&B5+I10&" to also change with the loop.
For i=1 to lastrow
.Range("X" & 13+i & "").Formula = "=$H$10+" & i & "" & "," & "B5+I" & i + 10 & "" & "," & "(2*$D$2+$E$2)/2"
Next i
Here code that can be used:
Sub mySub()
'=$H$10+1&","&B5+I10&","&(2*$D$2+$E$2)/2
Dim myRange As Range
Set myRange = Range("H:H").SpecialCells(xlCellTypeLastCell)
Dim myStr As String
'A=10 is for assigning first row in H as your data, hope no data upward from row 9 to row 1
For Baris = 10 To myRange.Row
On Error Resume Next
myStr = "=$H$10+" & Baris - 9 & "&"",""&B5+I" & Baris & "&"",""&(2*$D$2+$E$2)/2"
Range("K" & Baris).Formula = myStr
Next
End Sub
My goal is to be able to "translate" for lack of a better term; each cell in a sheet range into VBA.
This means I can instantly take an existing workbook and produce VBA to recreate it.
So I put this UDF together. It shows a cell as it would appear in VBA. R1C1 format
Function showformula(rng As Range)
If rng.HasArray = True Then
showformula = "{" & rng.Formula & "}"
Else
showformula = "Sheets(""" & ActiveSheet.Name & """). Range(""" & rng.Address & """)" & ".FormulaR1C1 = " & """" & rng.FormulaR1C1 & """"
End If
End Function
So 1)show a user select box for specifying a range. Then Click Proceed and 2) the above UDF reads for every cell in the specified range and 3) prints each cell's result on a new line in cell ZZ.
1 is easy enough to googlefu
but 2) & 3) I do not know how I would write it
https://www.reddit.com/r/excel/comments/brndla/how_to_apply_formula_to_every_cell_in_range_and/
Solution Occurred here
Sub BuildList()
Dim c As Range
Dim rngInput As Range
Dim rngOutput As Range
Dim i As Long
'Ask our user for stuff
Set rngInput = Application.InputBox("What cells do you want to read?", "Input", , , , , , 8)
Set rngOutput = Application.InputBox("Where do you want output to go?", "Output", , , , , , 8)
Application.ScreenUpdating = False
'Write the answers
For Each c In rngInput.Cells
rngOutput.Cells(1).Offset(i).Value = ShowFormula(c)
i = i + 1
Next c
Application.ScreenUpdating = True
End Sub
Function ShowFormula(rng As Range)
If rng.HasArray = True Then
ShowFormula = "{" & rng.Formula & "}"
Else
ShowFormula = "Sheets(""" & ActiveSheet.Name & """). Range(""" & rng.Address & """)" & ".FormulaR1C1 = " & """" & rng.FormulaR1C1 & """"
End If
End Function