I have data in excel sheet, with headings in 1st Row, I want to trim them as shown below
For example
CT_CD_FILTER_AMT*_Integer
Change to
CT_CD_FILTER_AMT
Each column heading is different..and number of columns also different from each file
So I want select the value of each column and trim it until it reaches the blank cell in ( row1 only)
Pls help with code.
TIA.
Sub mac1()
Dim LastCol As Integer
Sheets("MySheet").Select
LastCol = Cells(1, 1).End(xlToRight).Column
For Each C In Range(Cells(1, 1), Cells(1, LastCol))
C.Value = Left(C.Value, InStr(C.Value, "") - 1)
Next C
End Sub
Or
Sub mac2()
Dim Col As Integer
Col = 1
Do While Cells(1, Col).Value <> ""
Cells(1, Col).Value = Left(Cells(1, Col).Value, InStr(Cells(1, Col).Value, "") - 1)
Col = Col + 1
Loop
End Sub
Related
I've been trying to re-work this code I found to combine and sum rows in a sheet.
I have a sheet with values in columns columns A-G. And a Dynamic number of rows.
If an exact duplicate is found in column D, I want to add (sum) the "column G" and "column H" values from the duplicate row, with the "G" and "H" values from the original row. With the result being in the original row.
For all other columns, I want the duplicate row to overwrite the original. (Or, overwrite if the exact same, and place next to the original value in the same cell if different, but this is beyond my knowledge.)
To clarify, the code will loop through column 'D' until it finds duplicate values. It will then delete the row of this duplicate value, after copying/pasting its values over those of the original. Except for "G" and "H", where it will sum its values with the original rows "G" and "h".
ie.
June 1
A
-----
1234
Walmart
6
7
June 2
B
BA
1234
Walmart
4
4
Would turn into
June 2
B
BA
1234
Walmart
10
11
In place of the original, for all duplicate (column "D") rows in the worksheet.
Thanks for any input.
This code I've been trying to change: works for 4 columns where column A is the ID as opposed to column D, and doesn't include the sum condition. I'm having trouble fitting it to my conditions. Specifically, why is the Cl range 'B' when this range isn't consequential, and what format the offset follows.
Sub mergeRows()
Dim Dic As Object: Set Dic = CreateObject("Scripting.Dictionary")
Dic.Comparemode = vbTextCompare
Dim Cl As Range, x$, y$, i&, Key As Variant
For Each Cl In Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row)
x = Cl.Value & "|" & Cl.Offset(, 1).Value
y = Cl.Offset(, 2).Value
If Not Dic.exists(x) Then
Dic.Add x, Cl.Offset(, -1).Value & "|" & y & "|"
ElseIf Dic.exists(x) And Not LCase(Dic(x)) Like "*|" & LCase(y) & "|*" Then
Dic(x) = Dic(x) & "|" & y & "|"
End If
Next Cl
Range("A2:D" & Cells(Rows.Count, "B").End(xlUp).Row).ClearContents
i = 2
For Each Key In Dic
Cells(i, "A") = Split(Dic(Key), "|")(0)
Range(Cells(i, "B"), Cells(i, "C")) = Split(Key, "|")
Cells(i, "D") = Replace(Split(Replace(Dic(Key), "||", ";"), "|")(1), ":", ";")
i = i + 1
Next Key
Set Dic = Nothing
End Sub
The example you are trying to copy seems overly complex and relies on objects only available on the Windows platform. I started from scratch to meet your needs with simpler code--I hope you are able to follow it and adjust as needed.
It combines data in this sheet:
into this:
Sub merge_rows()
Dim last_row As Long
Dim row As Long
Dim s As Worksheet
Dim col As Integer
Set s = ActiveSheet 'use this line to process the active sheet
'set s = thisworkbook.Worksheets("Sheet1") ' use this line to process a specific sheet
last_row = s.Cells(s.Rows.Count, 1).End(xlUp).row 'find the last row with data
For row = last_row To 3 Step -1
If s.Cells(row, "D").Value = s.Cells(row - 1, "D").Value Then
' found a match in column d
' add column G
s.Cells(row - 1, "G").Value = s.Cells(row - 1, "G").Value + s.Cells(row, "G").Value
' add column H
s.Cells(row - 1, "H").Value = s.Cells(row - 1, "H").Value + s.Cells(row, "H").Value
'append all other columns if different
For col = 1 To 6
If Not s.Cells(row, col).Value = s.Cells(row - 1, col).Value Then
s.Cells(row - 1, col).Value = s.Cells(row - 1, col).Value & " " & s.Cells(row, col).Value
End If
Next
' now delete the duplicate row
s.Rows(row).Delete
End If
Next
End Sub
I have a sheet with multiple columns and in column A there is data where I have removed the duplicates.
This is the code to insert nine blank lines below each of the unique values.
Sub RowAdder()
Dim i As Long, col As Long, lastRow As Long
col = 1 lastRow = Cells(Rows.Count, col).End(xlUp).Row
For i = lastRow To 3 Step -1
If Cells(i - 1, col) <> Cells(i, col) Then
Range(Cells(i, col).EntireRow, Cells(i + 8, col).EntireRow).Insert shift:=xlDown
End If
Next I
End Sub
I need to adapt this code to copy the values of each unique value to the blank lines below for column A to C.
On the last line I need the value to be copied down into 9 blank rows.
maybe you'ar after something like this
Sub RowAdder()
Dim i As Long, col As Long
col = 1
With Range(Cells(2, col), Cells(Rows.Count, col).End(xlUp))
For i = .Rows(.Rows.Count).Row To 3 Step -1
If Cells(i - 1, col) <> Cells(i, col) Then Range(Cells(i, col).EntireRow, Cells(i + 8, col).EntireRow).Insert shift:=xlDown
Next i
With .Resize(.Rows.Count + 9)
With .SpecialCells(xlCellTypeBlanks)
.FormulaR1C1 = "=R[-1]C"
Intersect(.EntireRow, Range("B:C")).FormulaR1C1 = "=RC[-1]"
End With
With Intersect(.EntireRow, Range("A:C"))
.Value = .Value
End With
End With
End With
End Sub
I would like to repeat ID number based on the "number" number. For example:
to
I have tried the following so far..
Sub MySub()
Do While B2 = n
CurrentSheet.Range("a1:c1").EntireRow.Resize(n).Insert
Loop
End Sub
It probably doesn't make much sense, as I am fairly new!
If you wanted to list the data in column D, you could use this
Sub x()
Dim r As Range
For Each r In Range("A2", Range("A" & Rows.Count).End(xlUp)) 'loop through A
Range("D" & Rows.Count).End(xlUp)(2).Resize(r.Offset(, 1).Value).Value = r.Value 'duplicate number of times in B
Next r
End Sub
If you want to insert into your existing data
Sub x()
Dim r As Long
For r = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
If Cells(r, 2) > 1 Then
Cells(r + 1, 1).EntireRow.Resize(Cells(r, 2).Value - 1).Insert shift:=xlDown
Cells(r + 1, 1).Resize(Cells(r, 2).Value - 1) = Cells(r, 1).Value
End If
Next r
End Sub
Goal: If Column C does not start with "XXX*" then Return that cell minus the first 5 characters.
Example:
C2 = XXX Then B2 would be empty
C3 = YYY1220190318 Then B3 = 20190318
C4 = UGA1535D Then B4 = 1535D
'Here is my Actual Code
Dim arrData As Variant, LastRow As Long, i As Long, ws As Worksheet
Set ws = ThisWorkbook.Sheets("Long List 15032019") 'change
the name of the sheet to the one you are doing the code
With ws
LastRow = .Cells(.Rows.Count, 3).End(xlUp).Row
arrData = .Range("A2", .Cells(LastRow, "C")).Value
For i = 1 To UBound(arrData)
If arrData(i, 3) Like "Bus*" Then
arrData(i, 1) = "BU CRM"
Else
arrData(i, 1) = "CSI ACE"
End If
If arrData(i, 3) Like "CSI*" Or arrData(i, 3) = vbNullString Then
arrData(i, 2) = vbNullString
Else: arrData(i, 2) = Right(arrData(i, 3), 12)
End If
Next i
.Range("A2", .Cells(LastRow, "C")).Value = arrData
End With
I think it's a single line of code that needs to be adjusted Else: arrData(i, 2) = Right(arrData(i, 3), 12)
I did attempt to use -12 or LEFT. But it would not work.
How about:
Sub KleanUp2()
Dim cell As Range, v As String, v2 As String
For Each cell In Intersect(Range("C:C"), ActiveSheet.UsedRange)
v = cell.Value
If Len(v) < 4 Then
vr = ""
Else
vr = Mid(v, 4, 9999)
End If
cell.Offset(0, -1) = vr
Next cell
End Sub
If the value in column C is more than 3 character, the first three characters are removed and the result placed in the same row in column B
If the value in column C is less then 4 characters (or the cell is empty), then a null is placed in column B in the same row.
Try:
Option Explicit
Sub test()
Dim Lastrow As Long, Row As Long
With ThisWorkbook.Worksheets("Sheet1")
Lastrow = .Cells(.Rows.Count, "C").End(xlUp).Row
For Row = 1 To Lastrow
If Left(.Range("C" & Row).Value, 3) = "XXX" Then
.Range("B" & Row).Value = ""
Else
.Range("B" & Row).Value = Mid(.Range("C" & Row).Value, 4, Len(.Range("C" & Row).Value) - 3)
End If
Next Row
End With
End Sub
I have 3 columns A, B, C and I want to make a column D with values in A, B, C but it should include ">=", "<=" signs as well. The script I am working on does help me loop around columns and copy its data to a new column. Can anyone help me figure out how I can add those special characters at the beginning of the numbers in the cells?
Thanks for any help.
Sub Try()
With ActiveWorkbook.Sheets("Sheet1")
For rw = 1 To .Rows.Count
If (.Rows(rw).Columns("A:A").Value <> "") Then
.Rows(rw).Columns("A:A").Copy .Range("D" & rw)
End If
Next rw
.Columns("A:A").Delete
End With
End Sub
With data in cols A through C, in D1 enter:
=IF(A1<>"",">="&A1,IF(B1<>"","<="&B1,C1))
and copy down:
EDIT#1:
To do this with VBA:
Sub PopulateFormulas()
Dim N As Long, s As String
s = "=IF(A1<>"""","">=""&A1,IF(B1<>"""",""<=""&B1,C1))"
N = Range("A1").CurrentRegion.Rows.Count
Range("D1:D" & N).Formula = s
End Sub
Probably not the most elegant solution (and you probably don't even need VBA for this, a formula would most likely suffice), but this does the trick:
Sub Test()
arr = Array(">=", "<=", "")
With ActiveWorkbook.Sheets("Sheet1")
For cl = 1 To 3
For rw = 2 To .Cells(ActiveSheet.Rows.Count, "C").End(xlUp).Row
If .Cells(rw, cl).Value <> "" Then
.Cells(rw, 4).Value = arr(cl - 1) & .Cells(rw, cl).Value
End If
Next rw
Next cl
End With
'If you still need to delete those columns at the end-
'ActiveWorkbook.Sheets("Sheet1").Columns("A:C").Delete xlShiftLeft
End Sub
This worked for me:
Sub macro_test()
k = 1
For k = 1 To 3
t = 2
lr = ActiveSheet.Cells(100000, k).End(xlUp).Row
Do Until t > lr
If Cells(t, k).Value = “” Then GoTo continue
If k = 1 Then Cells(t, 4).Value = ">=" & Cells(t, k).Value
If k = 2 Then Cells(t, 4).Value = "<=" & Cells(t, k).Value
If k = 3 Then Cells(t, 4).Value = "" & Cells(t, k).Value
continue:
t = t + 1
Loop
Next
End Sub
try this
Sub main()
Dim iCol As Long, cell As Range, signs As Variant
signs = Array(">=", "<=", "")
For iCol = 1 To 3
For Each cell In Columns(iCol).SpecialCells(xlCellTypeConstants, xlNumbers)
cell.Value = signs(iCol - 1) & cell.Value
Next
Next
End Sub
if your columns A, B and C not empty cells content is not a numeric one only, then you could use:
For Each cell In Columns(iCol).SpecialCells(xlCellTypeConstants)
while if it's some formula, then you could use:
For Each cell In Columns(iCol).SpecialCells(xlCellTypeFormulas)