I am trying to write a macro that removes unnecessary columns and copies/ pastes data from one column next to another. I then want it to take the worksheet name (which is variable) and concatenate it with the values in a static range of cells, but only after the columns have been modified.
The macro runs without error until the concatenate step.
Is there a better way to write this or what am I doing incorrectly? The error is "Object variable or With block not set". The error occurs at "Set rngTemp = ws.Range("A21", "H21")" line.
Thank you in advance for your consideration.
Sheets("Channel-0").Select
Range("F21:F62").Select
Selection.Delete Shift:=xlToLeft
Range("G21:H62").Select
Selection.Delete Shift:=xlToLeft
Range("H21:L62").Select
Selection.Delete Shift:=xlToLeft
Columns("G:G").Select
Range("G11").Activate
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("E21:E62").Select
Selection.Copy
ActiveWindow.SmallScroll Down:=-39
Range("G21").Select
ActiveSheet.Paste
Range("G19").Select
Application.CutCopyMode = False
ActiveWorkbook.Save
Dim ws As Worksheet
Dim rngCell, rngTemp As Range
Set rngTemp = ws.Range("A21", "H21")
For Each cell In rngTemp
cell.Value = ActiveSheet.Name & cell.Value
Next cell
End Sub
Related
My code fails to truncate anything beyond 40 characters when i run it. Any suggestions on what line I can use. The code is an xlam. I am trying to truncate anything in column G I tried to put in formula left(F2, 40). Maybe i am using a wrong formula? or there is another way to fix it. Please let me know. Here is the Code I have so far:
Option Explicit
Private Sub ProcessReport()
Dim oWB As Excel.Workbook
Dim oXLAM As Excel.Workbook
Dim oWS As Excel.Worksheet
Set oWB = ActiveWorkbook
Set oWS = ActiveSheet
Set oXLAM = Workbooks("NRPPosPay.xlam")
Call formatcols
End Sub
Sub formatcols()
Dim oWS As Excel.Worksheet
Dim LastPopulatedRow As Long
LastPopulatedRow = Range("G" & Rows.Count).End(xlUp).Row
'Delete Colums
Columns("F:H").Select
Selection.Delete Shift:=xlToLeft
'Move Colums
Columns("E:E").Select
Selection.Cut
Columns("B:B").Select
Selection.Insert Shift:=xlToRight
Columns("G:G").Select
Selection.Cut
Columns("C:C").Select
Selection.Insert Shift:=xlToRight
Columns("G:G").Select
Selection.Cut
Columns("C:C").Select
Selection.Insert Shift:=xlToRight
Columns("E:E").Select
Selection.Cut
Columns("D:D").Select
Selection.Insert Shift:=xlToRight
Columns("G:G").Select
Selection.Cut
Columns("E:E").Select
Selection.Insert Shift:=xlToRight
Columns("G:G").Select
Selection.Cut
Columns("F:F").Select
Selection.Insert Shift:=xlToRight
'Replace in Colums
Range("G:G").Replace What:=",", Replacement:=" "
Range("C:C").Replace What:="-", Replacement:=" "
Range("E:E").Replace What:="OCK", Replacement:="IS"
Range("E:E").Replace What:="VCK", Replacement:="CN"
'Formula in Columns
Range("G2").Formula = "=left(G2, 40)"
Range("G2: " & "G" & LastPopulatedRow).FillDown
'Copy and Paste
Range("G:G").Copy
Range("F:F").PasteSpecial _
Operation:=xlPasteSpecialOperationDivide
'Delete Column
Columns("G:G").Select
Selection.Delete Shift:=xlToLeft
'Replace
Range("F:F").Replace What:=",", Replacement:=" "
'Format columns
Columns("A:A").NumberFormat = "0"
Columns("B:B").NumberFormat = "0"
Columns("C:C").NumberFormat = "#.00"
Columns("D:D").NumberFormat = "mddyyyy"
' Delete Header row
Rows(1).EntireRow.Delete
End Sub
Sub ProcessPos(control As IRibbonControl)
Call ProcessReport
End Sub
Leaving all other changes that you can do to improve the code you should replace this line
Range("G2").Formula = "=left(G2, 40)"
with this one:
Range("G2").Value = Left(Range("G2").Value, 40)
This would make your code do what you desire for cell G2 now you can use loop to do this for all cells.
I have a list of names vertically consisting of 500+ rows on sheet1 as follow
Bill no (002, 003) Name (john, james ) Amount (455, 55)
whereas, I have a bill invoice shaped format on sheet2 and need to substitute the sheet 1 data on it.
the below vba code works perfectly for one particular row (A3:C3) but the problem im facing is that the list on sheet1 has 500 plus rows.
so kindly help me with an alternative where I can mouse click a random cell (A3) and the vba code copies the entire row (A3:C3) from sheet1 to sheet 2 to their respective places
Sub Macro13()
'Macro13 Macro
Range("A3").Select
Selection.Copy
Sheets("Sheet3").Select
Range("C4").Select
ActiveSheet.Paste
Sheets("Sheet2").Select
Range("B3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet3").Select
ActiveCell.Offset(0, 4).Range("A1").Select
ActiveSheet.Paste
Sheets("Sheet2").Select
Range("C3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet3").Select
ActiveCell.Offset(17, 3).Range("A1").Select
ActiveSheet.Paste
Range("c4").Select
End Sub
Please, test the next code:
Sub CopyCellsSpecificPlaces()
Dim sh2 As Worksheet, sh3 As Worksheet, aC As Range
Set sh2 = Sheets("Sheet2")
Set sh3 = Sheets("Sheet3")
Set aC = ActiveCell
If (Not aC.Parent Is sh2) Or (aC.Column <> 1) Then
MsgBox "You must run the code after selecting a cell in A:A column of ""Sheet1""...": Exit Sub
End If
sh3.cells(4, "C").Value = aC.Value
sh3.cells(4, "G").Value = aC.Offset(0, 1).Value
sh3.cells(21, "J").Value = aC.Offset(0, 2).Value
End Sub
you can refer to the following code and modify as you want.
Sub Macro13()
Sheets("Sheet2").Range("A3").Copy
Sheets("Sheet3").Range("C4").Paste
Sheets("Sheet2").Range("B3").Copy
Sheets("Sheet3").Range("A5").Paste
Sheets("Sheet2").Range("C3").Copy
Sheets("Sheet3").Range("D18").Paste
End Sub
I'm stuck on this, I don't understand why the code adds those extra zeros in column D; What am I doing wrong?
Code: https://pastebin.com/ccpqPJdz
last = Range("B" & Rows.Count).End(xlUp).Row
'Insert 3 columns on left. Add information in Row 1, add data in column D.
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Columns("E:E").Copy Destination:=Columns("C:C")
Columns("E:E").Select
Selection.Delete Shift:=xlToLeft
Range("D2:D2" & last).Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.FormulaR1C1 = "=R[-1]C[6]"
Columns("D").Copy
Columns("D").PasteSpecial xlPasteValues
Range("D1") = Time
Range("D1").NumberFormat = "h:mm:ss"
Input:
Output:
Avoid the Selection object. It's created as a medium of communication between the user and VBA via the screen. VBA has direct access to the Excel workbook and therefore doesn't need it. Please try this code.
Private Sub InsertThreeColumns()
Dim Rl As Long ' last used row
Dim Rng As Range
With Worksheets("NewTest") ' change to suit
Rl = .Cells(.Rows.Count, "B").End(xlUp).Row
.Columns(2).Copy
.Columns(1).Insert Shift:=xlToRight
Application.CutCopyMode = False
.Columns("A:B").Insert Shift:=xlToRight
.Columns(5).EntireColumn.Delete
On Error Resume Next
' next line will cause a crash if there are no blanks
Set Rng = .Range(.Cells(2, "D"), .Cells(Rl, "D")).SpecialCells(xlCellTypeBlanks)
If Err = 0 Then
Rng.FormulaR1C1 = "=R[-1]C[6]"
Rng.Copy
Rng.PasteSpecial xlPasteValues
End If
On Error GoTo 0
With .Cells(1, "D")
.Value = Time
.NumberFormat = "h:mm:ss"
End With
End With
End Sub
The extra zeroes that troubled you were caused by the method of defining the range where you wanted the formula to supply cell content. In your code that range is a derivative of a Selection. In the above code it's defined by starting cell and end cell. The result should be the same. It isn't because the route via the Selection object is circuitous and difficult to follow.
'I have a workbook with sheets containing data. I need the unique number to be filtered and copy the filtered data to another sheet, sheet name would be the unique number.
'i have tried to get all the numbers and remove duplicates, the remaining should be the filtered number to be copied.
'the error is i can copy the data to different sheets but not filtered according to their unique number
Sub filter()
Dim i As Integer
Dim ST As String
On Error Resume Next
i = 1
Application.ScreenUpdating = False
Do
ST = Sheets("duplicateshipto").Range("A" & i).Value
If ST <> "" Then
Sheets.Add.Name = ST
With Sheets("Template")
.Select
.Range("C1:BQ4").Select
Selection.Copy
Sheets(ST).Select
Sheets(ST).Range("A1").Select
Sheets(ST).Paste
.Select
ActiveSheet.Range("$A$4:$BU$88").AutoFilter Field:=26, Criteria1:=gsd
.Range("Z4", .Range("BS" & .Rows.Count).End(xlUp)).Select
Range("Z4").Select
Selection.End(xlDown).Select
.Range(Selection, Selection.End(xlDown)).Select
.Range(Selection, Selection.End(xlToRight)).Select
.Range(Selection, Selection.End(xlToRight)).Select
.Range(Selection, Selection.End(xlToRight)).Select
.Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets(ST).Select
Sheets(ST).Range("x5").Select
Sheets(ST).Paste
.Select
Range("BQ4").Select
Selection.End(xlDown).Select
.Range(Selection, Selection.End(xlDown)).Select
.Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets(ST).Select
Sheets(ST).Range("BO6").Select
Sheets(ST).Paste
.Select
Range("Y4").Select
Selection.End(xlDown).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToLeft)).Select
Range(Selection, Selection.End(xlToLeft)).Select
Range(Selection, Selection.End(xlToLeft)).Select
Range(Selection, Selection.End(xlToLeft)).Select
'Range(Selection, Selection.End(xlToLeft)).Select
Selection.Copy
Sheets(ST).Select
Sheets(ST).Range("a5").Select
Sheets(ST).Paste
End With
i = i + 1
End If
Loop Until ST = ""
Application.ScreenUpdating = True
End Sub
You are essentially trying to do something called Advanced Filter. However your code needs some improvement on all of the select options (as the comments state). Here's a sample macro that has several components you'll need for what you're trying to do such as:
It dynamically captures the range of all to the populated cells to the left and down of cell F6.
Uses the green range as what to filter (if not just leave F3:H3 blank)
Inserts values starting in cell A1 with a dynamic number of columns based on the number of data columns.
Excludes duplicates using Unique:=True (only one duplicate in sample)
Before Macro
After Macro
Code used in above illustration.
Sub exampleRefresh()
Dim cRng As Range, WS As Worksheet
Set WS = ActiveSheet
With WS
Set cRng = Sheet1.Range("F6")
Set cRng = Range(cRng, cRng.End(xlToRight))
Set cRng = Range(cRng, cRng.End(xlDown))
Dim fRng As Range
Set fRng = WS.Range("F2:H3")
Dim PRNG As Range
Set PRNG = WS.Range("A1")
Set PRNG = Range(PRNG, PRNG.Offset(, cRng.Columns.Count - 1))
End With
cRng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=fRng, CopyToRange:=PRNG, Unique:=True
End Sub
Also, as a teaser, Microsoft is going to be deploying a new Spill Feature soon. With this functionality, if you wanted to list the distinct values of a column, you could use a formula such as =Unique(A:A) in any cell and it will create a distinct list. No VBA or excessive clicking needed!
I need a macro to append a comma onto the beginning of a column of text strings. I recorded the action myself, but it limited itself to Column C (often, the text strings I need to do this with appear in a different column), and also limited the application of the range to the specific number of rows in the worksheet I recorded it on (in this case, 114).
Here is the original Record Macro output:
Sub AddCommaToESIID()
'
' AddCommaToESIID Macro
'
'
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("E:E").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("C2").Select
ActiveCell.FormulaR1C1 = ","
Range("C2").Select
Selection.AutoFill Destination:=Range("C2:C114")
Range("C2:C114").Select
Range("E2").Select
ActiveCell.FormulaR1C1 = "=RC[-2]&RC[-1]"
Range("E2").Select
Selection.AutoFill Destination:=Range("E2:E114")
Range("E2:E114").Select
Selection.Copy
Range("D2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Columns("E:E").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Columns("C:C").Select
Selection.Delete Shift:=xlToLeft
End Sub
I would like to modify this to achieve the following:
Make the macro apply to whatever Column I have selected, as opposed to Column C
Once I have selected a Column, make the macro apply to however many rows there are in the particular worksheet I'm working on.
Thanks in advance for your help!
This will change all non-formulas in whatever range you select
Sub AddCommaToESIID()
Dim rCell As Range
If TypeName(Selection) = "Range" Then
For Each rCell In Selection.Cells
If Not rCell.HasFormula Then
rCell.Value = "," & rCell.Value
End If
Next rCell
End If
End Sub