Excel macro to move column - excel

Basically I'm looking to move a column for one position to another.
561 DISK_GROUP_003 0 545 1
561 Disk_Group_iS 95 84144 80210
561 DISK_GROUP_iS 99 26335 26304
1415 t1_200ea 93 8804 8203
1415 t2_30010k 35 59846 21121
1415 t3_1tb72k 19 184941 36590
1415 t3_3tb72k 86 258635 224328
5018 t1_200ea 98 9905 9802
5018 t2_30015k 89 39987 35986
5018 t2_60015k 67 59984 40700
5018 t3_1tb72k 89 87567 78807
5018 t3_2tb72k 84 94412 79620
I need to move the 3rd column to the end at the right.
This is what I have tried so far:
Sub moveColumn()
With ActiveSheet
Excel.Columns(3).Cut
Excel.Columns(6).PasteSpecial
End With
End Sub
But this method doesn't work as it gets a runtime error '1004'.
Any help would be much appreciated.

For those wondering, it's possible to do this without replacing the contents of the destination column.
For example, to cut column B and insert it to the left of column F, you can use
Columns("B").Cut
Columns("F").Insert Shift:=xlToRight
You can also replace the named column headers with column indices, to taste (so Columns("B") becomes Columns(2))

Pastespecial doesn't work with Cut. You can do this:
Columns(3).Cut Range("F1")
Columns(3).Delete Shift:=xlToLeft 'if you want to delete the empty column

The problem with the other answers given is that the cut/paste technique uses the clipboard—overwriting whatever is in it, and making it impossible for the program to operate correctly if another program that also uses the clipboard is running (such as another instance of the same VBA project).
Instead, do this:
Application.CutCopyMode = False ' don't want an existing operation to interfere
Columns("F").Insert XlDirection.xlToRight
Columns("F").Value = Columns("B").Value ' this would be one greater if to the right of F
Columns("B").Delete
Just note that if there are references to the existing column, they will break and not be updated.

Related

How to replace an special character?

I am working on an excel vba macro which opens some files but I ran into a problem, some files have a special character and I cannot copy it to be able to make a replacement, I even tried to find the ASCII code but it throws me the same code as the common space, I can only see it in MS Word.
The tiny circle is the special char:
You can recognize characters in Word:
Sub PrintASCII()
s = Selection.Text
For i = 1 To Len(s)
Debug.Print Asc(Mid(s, i, 1))
Next
End Sub
Usage: select the symbols and run this Sub. See output in VBE Immediate window
Output
95
95
95
95
160
95
95
95
95
95
13

use left, mid and right functions to extract text between two characters/words?

I have the following data in a worksheet:
column A
431620121601 5201585 - 0006 Fresh Turkey Gravy 500g 27 -Cartons 27 162
431619121602 5204059 - 0006 Fresh Bread Sauce 300g 52 -Palettes 52 312
I want to get the number of cartons or palettes from the text and put this in column B
Column B
27 Cartons
52 Palettes
Here's what i have tried so far:
=MID(A8,SEARCH(" ",A8)+12,SEARCH("-Cartons",A8)-SEARCH(" ",A8)-4)
but this gives me this:
06 Fresh Turkey Gravy 500g 27 -Cartons
Please can someone show me a better way of doing this?
I was able to achieve what you want but with helper columns.
Col I has all possible Types listed like Cartons, Palettes etc.
Then I use these formula to get the results
To find Index of what Type is matching. this formula is to be entered as an array formula i.e. type the formula and press Ctrl Shift Enter
B2 =SUMPRODUCT(--IFERROR(IF(FIND($I$2:$I$4,A2)>0,TRUE,FALSE),FALSE)*ROW($I$2:$I$4))
Get what Type is matching
C2 =INDEX($I$1:$I$7,B2)
Get the ending string
D2 =RIGHT(A2,LEN(A2)-FIND(C2,A2)+1)
Get the last number
E2 =SUBSTITUTE(RIGHT(SUBSTITUTE(D2," ",REPT(" ",50)),50)," ","")
replace the last number and the Type with blank and add the Type at the end
F2 =TRIM(SUBSTITUTE(SUBSTITUTE(D2,E2,""),C2,"")) & " " & C2
Drag all the formulas down for each row of your data. Take note of the column I.
I know a UDF probably seems like overkill, but I am a huge fan of regular expressions, and I wish they were more mainstream within the VBA community the way they are in many other technologies.
So, with that in mind, here is a Regex solution to your problem:
Function UNITS(InputText As String) As String
Dim rx As New RegExp
Dim match As MatchCollection
rx.Pattern = "(\d+ )-([A-Za-z]+)"
If rx.Test(InputText) Then
Set match = rx.Execute(InputText)
UNITS = match(0).SubMatches(0) & match(0).SubMatches(1)
End If
End Function
The best thing about the Regex is the scalability. This can adapt in ways an inline formula would have trouble doing with irregular data.
Also, in the example above, the rx might be better suited as a global.
To use Regular Expressions, you will have to add a reference to "Microsoft VBScript Regular Expressions 5.5" to your project.

Shell script - convert Excel (xlsx) to CSV - remove blank space / tab space

I receive excel file (xslx) with multiple sheets for my project. The number of records on these sheets ranges from 15k to 70k per sheet. I need to perform following tasks on this data and then convert it to CSV. Or covert to CSV and then process the data either way its fine.
Input Example:
call_no uniq_no Type Strength Description
2456 15 TX SomeSting SomeSting
5263 15 BLL SomeSting SomeSting
4263 162 TX SomeSting
2369 215 LH SomeSting
4269 426 BLL SomeSting SomeSting
7412 162 TX SomeSting SomeSting
As per the requirement i need to
Find duplicate values in column 'uniq_no' and delete all duplicate records except the original record (first record).
Replace blanks with data. (Just simple find blank and replace with value logic)
Remove space/tab space in any cell. (This point is not important, its just like a side-quest)
Output Example:
call_no uniq_no Type Strength Description
2456 15 TX SomeSting SomeSting
4263 162 TX **NewDATA** SomeSting
2369 215 LH SomeSting **NewDATA**
4269 426 BLL SomeSting SomeSting
This is a routine task for me. I have fair knowledge of shell scripting. So if anyone can guide me even with rough outline of a script for this then i can do tweaks at my end. Please help.
Update: the desired platform for the script has been clarified and a vb-script response is no longer applicable. However, I will leave this response here in case a future viewer of this question stumbles upon it and finds it useful. Anyone writing a shell script in a Ubuntu language may be able to port over some aspects of this vbscript as well.
Here is something to get you started. If you record actions with Excel's macro recorder remember that using the same commands in a VBS means you have to get rid of all of the named parameters.
prep_xlsx.vbs
Set objExcel = WScript.CreateObject ("Excel.Application")
objExcel.Visible = true 'False 'True for testing
strFileName = "c:\tmp\vbs_test.xlsx"
set objWb = objExcel.WorkBooks.open(strFileName)
set objWs = objWb.Worksheets(1)
with objWs
with .cells(1, 1).CurrentRegion
.Cells.SpecialCells(4) = "**NewDATA**" ' 4 is xlCellTypeBlanks
.Cells.RemoveDuplicates 2, 1 ' Columns:=2, Header:=xlYes
for c = 1 to .Columns.Count
with .columns(c)
.TextToColumns .Cells(1), 2 ', Array(0, 1) 'Range("C1"), DataType:=xlFixedWidth, FieldInfo:=Array(0, 1)
end with
next 'next c
end with
end with
objWb.Close True 'save on close
objExcel.Quit
Set objExcel = Nothing
It should be noted that removing leading / trailing spaces with the Range.TextToColumns method with xlFixedWidth can attempt to split the column into two if there are too many leading spaces. Currently, this will halt the process as it will ask for confirmation on overwriting the next columns values (which you do not want to do). There has to be a significant number of spaces to have Excel guess that it belongs in two columns so unless there are more spaces than a typical word there is nothing to worry about; just something to be aware about. e.g. if there were twice as many leading spaces in D6, it might want to split across two columns.
            vbs_test.xlsx before prep_xlsx.vbs
            vbs_test.xlsx after prep_xlsx.vbs

Match items in list against themselves for semi-uniqueness

I'm really just looking for some kind of tool that will check for close approximations of duplicates in a column of data. For instance, say I have a column of data with addresses as such:
113 James Way
3448 Harlon Circle
5888 Murray Rd
3448 Harlon Cr.
In this case entry 2 and 4 would be very close to unique and I would like some kind of tool, either in excel or standalone, that would notify me if rows are being duplicated or approximately duplicated. I have no idea how to even search for something like this. I tried searches for fuzzy match tools and the like but nothing is quite what I need. Thanks,
There are several ways to approach
One simple method is to write a Levenshtein function to compare these addressed with each other and highlight low values
Assume you have the data setup as follows
Raw example
Sub FindClosestMatch()
Range("B3").Select
Dim mystrings()
Range("B3").Select
Range(Selection, Selection.End(xlDown)).Select
mystrings = Selection.Value
i = 0
Dim string1 As String, string2 As String
Range("C3").Select
For i = LBound(mystrings) To UBound(mystrings)
string1 = mystrings(i, 1)
For j = 1 To 4
string2 = mystrings(j, 1)
ActiveCell.Value = Levenshtein(string1, string2)
ActiveCell.Offset(0, 1).Select
Next
Range("c3").Offset(i, 0).Select
Next
End Sub
How to read values
For e.g 113 James Way 0 15 13 12 means the string has a score of
0 (exact match) with itself
15 with 3448 Harlon Circle
13 With 5888 Murray Rd
12 with 3448 Harlon Cr.
etc
The Macro just compares every address with other address and finds the Levenshtein distance
The lower the number the closest match they are and clearly 0 is exact match when it compares to itself
This macro assumes you have copied the Levenshtein function into your VBA Module
It really depends on how accurate you need it to be and what kind of close matches you want it to catch. If you want to catch typos it'd be a lot harder. But if you're mainly looking to catch St vs Street you could do a vlookup on the left(address, #) or something. Might have to toy with the # to get a good response. # needs to be higher then the number of digits in the street numbers (4/5?) but small enough to catch things like 1 dry ct. I'd guess 7-8.
Basically your addresses are in column A (assuming starting in A2 with headers). Column B says = left(a2,8)
A2 is obviously unique cause it's first.
Start in C3 with =vlookup(left(a3,8),$B$2:B2,1,0)
It'll print an error for all the unique entries and an address for the dupilcates. To make it cleaner you can add an if(iserror()) with
=if(iserror(vlookup(left(a3,8),$B$2:B2,1,0), "", vlookup(left(a3,8),$B$2:B2,1,0))

Copy down values in loop

Working on a project, I'm having a little issue on copying down values using a loop. i've tried to describe the issue down here as clearly as i can.
-What should be done, is that for each of the i's (1 to 83) and for the whole period (ie 1/1/2014-15/1/2014) values are copied below each other on Calculation sheet.
-What is happening so far, is that it copies down values but overwrites all days except for the first, for all i's except for the last.
Hence, the result after the macro is finished is: 1/1/2014 of i1, 1/1/2014 of i2 [...] till 1/1/2014-15/1/2014 for i83.
What should be the result is 1/1/2014-15/1/2014 for i1, 1/1/2014-15/1/2014 for i2 [...] till 1/1/2014-15/1/2014 for i83.
Sounds mysterious and unclear, but if here's the code which makes it hopefully more clear.
Sheets("Summary").Select
For i = 1 To 83
Sheets("Summary").Select
Sheets("Summary").Range("A10").Value = Sheets("Summary").Cells(i + 10, 1).Value
Sheets("Calculation").Select
Sheets("Calculation").Range(Cells(i + 17, 1), Cells(i + 31, 59)).Value = Sheets("Calculation").Range("a2:bg16").Value
Next i
Range("a1").Select
End Sub
I'm looking forward to your suggestions, if anything is not clear please let me know
Valentino
Question? Do you have observations of 83 item (in 83 columns) for each of the 15 dates (in rows?) or 83 rows of observations of the dates in 15 columns?
Worksheets("Summary").Range("A10:CF24").Copy Destination:=Worksheets("Calculation").Range("A10").Offset(17)

Resources