I'm grabbing data from SAP to paste into my Excel sheet via VBA. (There are other methods for exporting data, but this is the one I am limited to.)
The data is put into the Windows-Clipboard via SAP. Afterwards it is put into the newest Excel-Worksheet (see Sub importStuff and then formatted see Sub divData) The data is delimited with pipes | and after pasting it looks like this (including the blanks):
| FOO: BAR | 360.000 |
After I Call divData it is split into two separate columns. (this how I want it to be formatted)
[SOME_ID: SOME_NAME][360.000]
Sometimes Excel formats 360.000 to 360,000 = 360. This only happens for values that end in a 0. So 360.000 is formatted to 360, 312.312.001.800 would be formatted to 312.312.001,80.
I'm using a German version of Excel 14.0.7166.5000 (32-Bit). So a . is for digit grouping, a , is the decimal mark.
This my code
Sub importStuff()
dBegin = wsUeb.Range("BeginPlan")
dEnd = wsUeb.Range("EndPlan")
'lots
'of
'other
'SAP-Stuff
SAP_Session.findById("wnd[0]/usr/tabsTABSTRIP_MYTAB/tabpPUSH4/ssub%_SUBSCREEN_MYTAB:ZCO_SUSAETZE_NEW:0400/ctxtP_LAYOUT").Text = "/ZL_UMSPIEXP"
SAP_Session.findById("wnd[0]/tbar[1]/btn[8]").press
SAP_Session.findById("wnd[0]/tbar[1]/btn[45]").press
SAP_Session.findById("wnd[1]/usr/subSUBSCREEN_STEPLOOP:SAPLSPO5:0150/sub:SAPLSPO5:0150/radSPOPLI-SELFLAG[4,0]").Select
SAP_Session.findById("wnd[1]/tbar[0]/btn[0]").press
ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Paste
Worksheets(Worksheets.Count).Name = "Plan-Umsaetze " & dBegin & " - " & dEnd
Call divData
End Sub
Sub divData()
ActiveSheet.Columns("A:A").TextToColumns _
DataType:=xlDelimited, _
TextQualifier:=xlTextQualifierNone, _
ConsecutiveDelimiter:=False, _
Other:=True, _
OtherChar:="|"
End Sub
Here is what happens.
I open the workbook
I call importStuff
I call divData afterwards, doesn't matter if it is called within importStuff or not
everything is fine
I call importStuff again
I don't call divData at all (doesn't matter if I do)
I get erroneous values
But if I just press Ctrl+v the values get inserted just fine (see 4.)).
I can't call Ctrl+v via Windows Shell, because the new worksheet is invisible for the user.
This is just Jochen's and my comment posted as an answer. I had the same issue today, that's why I necro'd this post.
I formatted the column to text, imported the data, changed the format back to numbers and then multiplied each value with 1. That did the trick.
you could set Range.numberFormat
or use Range.PasteSpecial( [xlPasteTypes], [xlPasteOperation]), doc here, particularly xlPasteValuesAndNumberFormats or xlPasteSpecialOperationMultiply
I have the same issue but I can solve it by:
range("A1").PasteSpecial(-4142)
it seems like excel sees "---------" as calculation.
Related
Original Post: Here (New post as it started to get very clunky and dragged away from the issues at hand)
I am looking to automatically grab data from an excel CRM output and take certain values into a new sheet. I have had a bit of luck with my progress, but I am still struggling to adapt the code properly.
First Iteration of Code:
Sub Client_CRM()
Range("A4:A44,C4:C44,G4:H44").Select
Selection.Copy
Sheets("Output Sheet").Select
Range("A1").Select
ActiveSheet.Paste
End Sub
Current code:
Sub Client_CRM()
Dim ClientStartRow As Long, ClientEndRow As Long
Dim Listed As Long
Set PortfolioRange = Worksheets("Client Paste").Range("A:M")
Set Listed = Worksheets("Client Paste").Range("A:A")
With Sheets("Client Paste")
Sheets("Output Sheet").Cells.Clear
Worksheets("Client Paste").Activate
ClientStartRow = .Range("A3").Row
':A").Find(What:="Listed", after:=.Range("A1")).Row
ClientEndRow = .Range("A:A").Find(What:="Totals", after:=.Range("A3"), LookIn:=xlValues, lookat:=xlPart, MatchCase:=False).Row
Range(ClientStartRow & ":" & ClientEndRow).Select
Selection.Columns(1).Copy
Sheets("Output Sheet").Select
Range("A3").Select
ActiveSheet.Paste
Sheets("Output Sheet").Range("B1:B70") = Application.VLookup(Listed, PortfolioRange, 8, False)
Sheets("Output Sheet").Range("C1:C70") = Application.VLookup(Listed, PortfolioRange, 3, False)
Sheets("Output Sheet").Range("D1:D70") = Application.VLookup(Listed, PortfolioRange, 7, False)
End With
End Sub
As you can see, I've slowly added and learnt more things throughout today.
What I am now looking to do is:
Find a better way to copy the columns over to the new sheet. **An issue that I have encountered is that maybe 1/10 CRM exports have an additional column, so the VLOOKUP can't accurately be used 100% - The CRM export has headers. Can I use some sort of code to grab these columns by value? They are exported and on Row 2. "Listed" "Quantity" "MV" "PW" are the 4 headings. Usually they are columns: 1,3,7,8 but in a rare instance they are 1,3,8,9...
Find a way to remove certain "blacklist" products. All products generally have a 3 part code that they are identified as. There are certain 3 part codes I do not want included and I want to be able to update this as time goes on. Ideally, I'd like to make a separate sheet with these codes and if they match to anything from the export, they aren't copied over...
Some product codes have 5 characters instead of 3, I'd like these ones to be coped in the same list but added to a separate list (Unsure if this is possible?)
Update:
Have worked out how to get the code to bring the 4 columns I want regardless of their order over.
Set PPSExport = Range("A2:M2")
For Each cell In PPSExport
If cell.Value = "Asset" Then
cell.EntireColumn.Copy
ActiveSheet.Paste Destination:=Worksheets("Output Sheet").Range("A:A")
End If
If cell.Value = "Quantity" Then
cell.EntireColumn.Copy
ActiveSheet.Paste Destination:=Worksheets("Output Sheet").Range("B:B")
End If
If cell.Value = "Market value" Then
cell.EntireColumn.Copy
ActiveSheet.Paste Destination:=Worksheets("Output Sheet").Range("C:C")
End If
If cell.Value = "Portfolio weight %" Then
cell.EntireColumn.Copy
ActiveSheet.Paste Destination:=Worksheets("Output Sheet").Range("D:D")
End If
Next cell
Sheets("Output Sheet").Select
End With
Thanks for any help,
I've already learnt so much already -- any pointers would be greatly appreciated :D
Yes, all of these things are possible. I will give a brief description on how to accomplish all of these things, but I recommend that you try to research how to do each of these tasks on your own before asking another question(s). It's also a good idea to keep the scope of your question limited. For example, you are asking about 3 loosely related items here. Yes, they are related to one another via your project, but in the general world of VBA programming, they are not. This will keep the conversation focused and easier to follow.
Find a better way to copy the columns over to the new sheet.
You made a great observation: your data is imported with headers. And your proposal is possible. You can certainly use the headers of a range (or table) to copy data. You could:
Iterate through all cells in the header row
If you come across one you are interested it, copy all of the data in that column to the new sheet
If you come across a column header you are not interested in, just skip it and move to the next one
Find a way to remove certain "blacklist" products.
This is possible, and your proposed solution sounds ideal to me. Keep a record of all blacklist values in a sheet, and reference that list when necessary.
Some product codes have 5 characters instead of 3, I'd like these ones
to be coped in the same list but added to a separate list
Certainly possible. Once you have your data:
Iterate through all of it and check how many characters are in the value
If there are 5, copy that data to a new location or store it somewhere
If there are not 5, move on to the next value
How do I get excel to recognize timestamps as timestamps rather than strings?
If I do a find and replace on "/" with "/" it fixes it on most files:
Cells.Replace What:="/", Replacement:="/", LookAt:=xlPart, SearchOrder :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
I have a chunk of code that checks if it's still in the wrong format by converting to "Comma" format and checking if the cell contains any "/" characters, then a break line that triggers in that instance to alert me that I need to manually do the find and replace on this file. If I stop the Macro when it fails and run it manually (Crtl+h, Enter), then it works and I can restart the macro to finish the standardisation. I need a way of automating this.
I have >2000 .csv files of a similar but not identical format. Each one contains ~350 variables, each with it's own timestamp and data column. I've written some code that formats it into a usable format. The original csv has the timestamps in "DD/MM/YYYY hh:mm:ss" format as is my computer and Excel default.
Excel seemingly randomly decides it can't recognise around a quarter of the files timestamps and instead interprets them as strings. This can be corrected by clicking into the cell and then clicking out of the cell, then excel recognises it as a timestamp. I need the timestamps recognised so that I can interpolate values into a standard sampling frequency as Excel can't interpolate using values it interprets as strings.
There are often well over 100k timestamps per file, so doing this manually isn't an option.
I've tried using SendKeys. The problem with that seems to be that it opens the find and replace dialogue for the VBA script editor, not for the excel sheet.
I've tried shifting focus before by calling:
Windows(windowname).Activate
ActiveWorkbook.Application.SendKeys("^h")
I've also tried:
Windows(windowname).Application.SendKeys("^h")
Which both result in the find and replace being called on the VBA script editor.
I have no shortcut to start the Macro.
I've tried Matlab, but it can't deal with the header on the file or the columns populated with text. I'd like to retain all the data.
I have used the Macro recorder to record me doing the find and replace which results in:
Sub Fixer()
'
' Fixer Macro
'
'
Selection.Replace What:="/", Replacement:="/", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Sub
But this doesn't work when you run it on the same file.
I expect it to convert the string "DD/MM/YYYY hh:mm:ss" format into a date-time format that I can then convert into decimal format which I can then use for interpolating the values into a usable format. Instead I get no error message, and nothing happens.
An example line of date timestamps from the raw CSV is:
"31/03/2019 14:55:57,1.0000000149,31/03/2019 14:55:57,14.6,31/03/2019 14:55:57,57.86,31/03/2019 14:55:57,0.175000000000068"
So the timestamp "31/03/2019 14:55:57" I want converting into "43555.62218750000"
I could use a script to deconstruct the string, calculate the decimal equivalent, and overwrite the cell, but this will take a prohibitively long time.
First import the date/time field into Excel as Text. In my demo case I use column A. Then run:
Sub TextToValue()
Dim Kolumn As String, N As Long, i As Long
Dim d As Double, dt As Date, tm As Date
Dim v As Variant
Kolumn = "A"
N = Cells(Rows.Count, Kolumn).End(xlUp).Row
For i = 1 To N
v = Cells(i, Kolumn).Text
If InStr(1, v, "/") > 0 Then
arr = Split(v, " ")
brr = Split(arr(0), "/")
dt = DateSerial(brr(2), brr(1), brr(0))
tm = TimeValue(arr(1))
d = CDbl(dt + tm)
Cells(i, Kolumn).Clear
Cells(i, Kolumn).Value = d
End If
Next i
End Sub
Before:
And after:
You need to back up a step.
Your problem is common and is caused by OPENing a csv file where the date format (DMY) in this case is in a different format than your Windows Regional Setting on the your computer.
So even the input that appears to convert properly, will not be as the Day and Month will be exchanged from what you might expect.
Arguably the "best" fix for this issue, assuming you cannot alter the csv file, will be to IMPORT the file instead.
Depending on how you do the IMPORT, and that is Excel version dependent, you will have the opportunity, at the time of import, to define the date format of the incoming data, so it will be properly converted by Excel.
In Power Query you can specify to have PQ do the date conversion according to a specified locale. In earlier versions of Excel, a Text-to-columns wizard will open allowing you to specify DMY for the format of the csv file. I would suggest using PQ as it can easily handle the time portion, whereas with the older wizard you'll need to split the two, and then add them back together.
Having another problem.
I am creating another Excel tool at my facility and currently what I have pulls data from a purchase order tracking website and filters out superfluous data, leaving only the purchase order label itself, a single quotation mark, and an end bracket. I need to remove the quotation mark and ending bracket so I only have the PO itself, as I need this to inject into another site's URL. I have tried using wildcards with some code I wrote however the PO will get replaced with several asterisks, aka "wildcards," instead. I am probably overlooking something obvious, but I can't figure it out.
Example of data:
Code example:
Sub Filter_DockMaster_Data2()
Dim Main As Worksheet
Set Main = Worksheets("Main")
Dim ISA_List As Worksheet
Set ISA_List = Worksheets("ISA_List")
Dim ISA_Results As Worksheet
Set ISA_Results = Worksheets("ISA_Results")
Dim ISA_Raw As Worksheet
Set ISA_Raw = Worksheets("ISA_Raw")
Worksheets("ISA_Results").Select
Range("A1").Select
Do Until IsEmpty(ActiveCell)
ActiveCell.replace What:="********"" ]", Replacement:="********", LookAt:= _
xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Hopefully this makes sense.
Quick notes, the length of the PO will vary as time goes on, so I would like to make it dynamic if possible. Any help is appreciated, thanks.
Encode for a URL
How about the function intended for making text URL-friendly? :)
=ENCODEURL(A1)
For example, this:
1234ABCD']
...becomes encoded as:
1234ABCD%27%5D
...ready to insert in a query parameter (URL) string. See the documentation including further examples at at the link below.
Text Functions like LEFT
That said, there are several other ways to do this.
You said "replace" but it looks like you just need to cut off the last 2 characters?
This cuts the last 2 characters of the text in A1:
=LEFT(A1,LEN(A1)-2)
SUBSTITUTE Function
If you do want to "replace" text in a cell, you can use SUBSTITUTE:
Example:
If cell A1 contains:
1234ABCD']
...you could enter in another cell:
=SUBSTITUTE(A1,"]","")
...which would remove only the ]. You can also nest functions. To remove both the ] and the ', use this formula instead:
=SUBSTITUTE(SUBSTITUTE(A1,"]",""),"'","")
The SUBSTITUTE function syntax:
SUBSTITUTE( text, old_text, new_text, [instance_num] )
The SUBSTITUTE function syntax has the following arguments:
Text - (Required) The text or the reference to a cell containing text for which you want to substitute characters.
Old_text - (Required) The text you want to replace.
New_text - (Required) The text you want to replace old_text with.
Instance_num - (Optional) Specifies which occurrence of old_text you want to replace with new_text. If you specify instance_num, only that instance of old_text is replaced. Otherwise, every occurrence of old_text in text is changed to new_text.
(Source & More Info)
More Information:
Microsoft Support: ENCODEURL function (Excel)
Stack Overflow : Use MID, LEN, and FIND functions to extract certain cell portions?
Microsoft Support : SUBSTITUTE Function
JayTray : The LEFT, RIGHT and MID formulas in Excel
Microsoft Support : Text functions (reference)
Your problem shouldn't be about repairing the the data you've extracted from some source. It really should be about fixing the retrieval procedure so you do not get rogue characters.
With that said, this sub procedure should quickly remove any rogue characters from column A.
Option Explicit
Sub posOnly()
Dim i As Long, str As String, rgx As Object
Set rgx = CreateObject("VBScript.RegExp")
'pattern for A-Z (case sensitive) or 0-9 exactly 8 characters/digits in length
rgx.Pattern = "[A-Z0-9]{8}"
With Worksheets("ISA_Results")
For i = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
str = .Cells(i, "A").Value2
If rgx.Test(str) Then
str = rgx.Execute(str).Item(0)
.Cells(i, "A") = str
End If
Next i
End With
End Sub
I have recently migrated to pclinuxos from windows and seem to like it. The only problem I am facing is that libreoffice, the default spreadsheet package is not compatible with excel macros. Below is the vba code I have:
Option VBASupport
Sub DeleteToLeft()
Selection.SpecialCells(xlBlanks).Delete shift:=xlToLeft
End Sub
Function SinceLastWash()
Application.Volatile
WashCount = 0
WearCount = 0
CurrentRow = Application.ThisCell.Row
For i = 3 To 35
If Range(Cells(CurrentRow, i), Cells(CurrentRow, i)).Value = "a" Then
WearCount = WearCount + 1
End If
If Range(Cells(CurrentRow, i), Cells(CurrentRow, i)).Value = "q" Then
WashCount = WashCount + 1
WearCount = 0
End If
Next i
SinceLastWash = WearCount
End Function
Function testhis()
testhis = Application.ThisCell.Row
End Function
Is there a way to convert this code to make it compatible with libreoffice or do I have to learn an altogether new language like python? Learning python would not be a problem but is not a solution to my problem as I have many work related files in excel which have a lot of vba code and it is not possible for me to use open office/libreoffice at work...
I just want to add that the function SinceLastWash gives the correct value in some cells where I use it and in others gives an error, #NAME?
Thanks
From LibreOffice's online help file:
With a few exceptions, Microsoft Office and LibreOffice cannot run the same macro code. Microsoft Office uses VBA (Visual Basic for Applications) code, and LibreOffice uses Basic code based on the LibreOffice API (Application Program Interface) environment. Although the programming language is the same, the objects and methods are different.
The most recent versions of LibreOffice can run some Excel Visual Basic scripts if you enable this feature at LibreOffice - PreferencesTools - Options - Load/Save - VBA Properties.
In reality, you would most likely need to sit down with the LibreOffice API and rewrite the functionality.
You must translate the portions that manipulate the document to use the UNO API. Sadly, this can be tricky depending on what your macro does. Basic statements work directly. Modifying a document generally does not.
Range(Cells(CurrentRow, i), Cells(CurrentRow, i)).Value = "a"
The Cells command returns a specific cell based on a row and column. So, you need the current row. Here is some craziness to get the active cell:
Sub RetrieveTheActiveCell()
Dim oOldSelection 'The original selection of cell ranges
Dim oRanges 'A blank range created by the document
Dim oActiveCell 'The current active cell
Dim oConv 'The cell address conversion service
Dim oDoc
oDoc = ThisComponent
REM store the current selection
oOldSelection = oDoc.CurrentSelection
REM Create an empty SheetCellRanges service and then select it.
REM This leaves ONLY the active cell selected.
oRanges = oDoc.createInstance("com.sun.star.sheet.SheetCellRanges")
oDoc.CurrentController.Select(oRanges)
REM Get the active cell!
oActiveCell = oDoc.CurrentSelection
oConv = oDoc.createInstance("com.sun.star.table.CellAddressConversion")
oConv.Address = oActiveCell.getCellAddress
Print oConv.UserInterfaceRepresentation
print oConv.PersistentRepresentation
REM Restore the old selection, but lose the previously active cell
oDoc.CurrentController.Select(oOldSelection)
End Sub
When you have the active cell, you get the cell address, and from that, you have the row. You do not need to use the range at all, since you only care about a single cell, so, you get the active sheet and then get a particular cell from the sheet.
Something like this:
ThisComponent.getCurrentController().getActiveSheet().getCellByPosition(nCol, nRow).getString() = "a"
I don't feel like figuring out what this does
Selection.SpecialCells(xlBlanks).Delete shift:=xlToLeft
In LibreOffice 4.4, the first subroutine will not work at all (I suspect due to all the variables beginning with 'xl'. The other two work perfectly if you change ThisCell to ActiveCell.
Rather than
Option VBASupport
I am using
Option VBASupport 1
Option Compatible
The only automatic tool I'm aware of is Business Spreadsheets (note that I have no personal or professional experience nor any affiliation with the site).
It seems specific to OpenOffice but I think it works with LibreOffice too.
In general though, you're better off doing this yourself, as the tool is far from perfect...
Selection.SpecialCells(xlBlanks).Delete shift:=xlToLeft deletes blank cells if I'm not mistaken
I created a VBA form and macro that will generate auto-numbered documents for my company. Depending on the cost-center selected it will choose a Word document to complete the merge. It basically generates an alpha-numeric sequence in Column A under the header 'FirstName' (FirstName played nicely with Word as a 'source' field).
Everything seemed to be working fine until I went to produce a sequence that had a leading zero. Every leading zero after my 'manual' (starting number) entry from the form got auto-removed. I did some reading and ended up just checking the Len() of my string and re-inserted the 0 if it was less than the number of digits that the input (starting) number had. Hope you're still following me here. :)
Here is what I think happened... I had tried some other things in the beginning, including having the macro write out the sequence with a single quote ('), but it kept removing those leading zeros before that point. I highlighted the entire column and formatted as text (so, technically 64,000+ rows?) but again, same issue. The work-around in my last paragraph solved the issue, but now the merge is attempting to merge ALL rows in the column.
The answer may be simple, but what am I looking for to get it to STOP when the sequences stop? I have one routine that generates the numbers, and it only generates as many as I want:
For i = 1 To strFormNums
If Len(strStartVal) < 4 Then
rngFormNumbers(i).Value = strCampus & "0" & strStartVal 'Appends a single 0 to show before the starting numbers (making 0800 instead of 800). Otherwise Excel will lose the leading zero after the first number.
Else
rngFormNumbers(i).Value = strCampus & strStartVal
End If
strStartVal = strStartVal + 1
Next i
I have tested this. It doesn't generate more than, say, 200 or 500 lines.
Here is a snippet from the mail merge, which I'm thinking is grabbing ALL lines now for some reason (it didn't before):
strWorkbookName = ThisWorkbook.Path & "\" & ThisWorkbook.Name
wdocSource.MailMerge.MainDocumentType = wdFormLetters
wdocSource.MailMerge.OpenDataSource _
Name:=strWorkbookName, _
AddToRecentFiles:=False, _
Revert:=False, _
Format:=wdOpenFormatAuto, _
Connection:="Data Source=" & strWorkbookName & ";Mode=Read", _
SQLStatement:="SELECT * FROM `Numbers$`"
With wdocSource.MailMerge
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
End With
.Execute Pause:=False
End With
If I had to venture a guess I would say that the SQL statement is now 'seeing' more rows because the whole column has been formatted? I did a manual merge and sure enough there were thousands of blanks after my 200 numbers ended. I filtered them out manually in Word, but I would like to fix this because obviously my program was meant to automate this process.
If anyone needs to see more code I will be happy to provide it. Thanks in advance.
After some experimenting, I decided to remove all formatting from Column A using Clear > Clear Formats (Excel 2010). The mail merge is now terminating at the first blank line instead of running through the entire column.
It seems that highlighting a column and formatting as Text (for instance) can really muck up a mail merge. If I'm mistaken please feel free to correct me, but this is what seems to have solved my issue.