VBA macro concatenate 2 columns in new column - excel

I want to create a macro that inserts new column with column name (BL & Container) and then concatinates 2 column in newly inserted column.
In this column I named BL & Container is a new column added my macro.
Further I want the macro to concatenate the values present in column H and F macro should find column H and F by column name and concatenate the them in to newly inserted column I.
My codes below
Sub insert_conc()
Dim ColHe As Range
Dim FindCol As Range
Dim con As String
Dim x As Long
Set FindCol = Range("1:1") 'Looks in entire first row.
Set ColHe = FindCol.Find(what:="BL/AWB/PRO", After:=Cells(1, 1))
With ActiveWorkbook.Worksheets("WE")
ColHe.Offset(0, 1).EntireColumn.Insert
ColHe.Offset(0, 1).Value = "WER"
'x = Range("A" & Rows.Count).End(xlUp).Row
con = "=H2&""-""&F2"
ColHe.Resize(x - 1).Formula = con
End With
Application.ScreenUpdating = True
End Sub
[![Error in code][3]][3]
In this code line " con = "=H2&""-""&F2"" please advise how do I update column nameinstead of H2 and F2 macro should find columna H2 and F2 header name and then concatinate the values in newly inserted column I BL & container. Please advise.

Please, use the next adapted code:
Sub insert_conc()
Dim sh As Worksheet, x As Long, ColHe As Range
Dim FindCol As Range, con As String, firstCell As Range
Set sh = Worksheets("LCL")
x = sh.Range("A" & sh.rows.count).End(xlUp).row
Set FindCol = sh.Range("1:1") 'Looks in entire first row.
Set ColHe = FindCol.Find(what:="BL/AWB/PRO", After:=sh.cells(1, 1))
ColHe.Offset(0, 1).EntireColumn.Insert
ColHe.Offset(0, 1).value = "BL & Container"
Set firstCell = ColHe.Offset(1, -2) ' determine the cell to replace F2
con = "=" & ColHe.Offset(1).Address(0, 0) & "&" & firstCell.Address(0, 0)
ColHe.Offset(1, 1).Resize(x - 1).Formula = con
End Sub
It is also good to know that using With ActiveWorkbook.Worksheets("LCL") makes sense only if you use it in the code lines up to End with. And your code did not do that... It should be used before, in order to deal with the appropriate sheet, even if it was not the active one.

Related

Inserting a column

I am hoping someone could give me some guidance here. My situation is this:
One worksheet with 100 rows of data in a table
Each cell in Column A holds one of two values - either CSv1 or CSv2
Column B holds a specific case_number
I want to insert a column at position 4 (Column D) with the label 'Caselink'
In location D2 I am trying to insert a hyperlink that builds off A2 and B2 where the link is dependent on the value in both. (they go to two different sites depending on column A). Then to populate down with relative location to row numbers... Here is what I have so far, but it gives me an error on the 'Else' statement saying I havean 'Else without If'.
If I take out the else statement and follow-on formula, and leave only the first If formula, it will populate all cells in the D column with the link for the CSv1 value.
Thoughts?
Sub InsertHyperlink_EscFeedback()
With ActiveSheet
.ListObjects(1).Name = "Drilldown"
End With
Dim ws As Worksheet
Set ws = ActiveSheet
Dim target_table As ListObject
Set target_table = ws.ListObjects("Drilldown")
Dim activeTable As String
activeTable = ActiveSheet.ListObjects(1).Name
ActiveSheet.ListObjects(1).Range.Activate
Selection.ListObject.ListColumns.Add Position:=4
Range("D1") = "CaseLink"
Range("D2").Select
If Range("A2").Value = "CSv2" Then _
ActiveCell.FormulaR1C1 = _
"=HYPERLINK(""https://open.companytest.com/fredsfakeurl.aspx?conv=""&[#[case_number]]&""&st="",[#[case_number]])"
Else
ActiveCell.FormulaR1C1 = _
"=HYPERLINK(""https://open.companytest.com/janesfakeurl.aspx?rdx=9992956J43211&help=""&[#[case_number]]&""&st="",[#[case_number]])"
Range("A1").Select
End If
Cells.Select
Cells.EntireColumn.AutoFit
End Sub
Try this. You'll need to adjust the column header for the first column (CSv1/2)
Sub InsertHyperlink_EscFeedback()
Const LINK1 = "HYPERLINK(""https://open.companytest.com/fredsfakeurl.aspx?conv=""&[#[case_number]]&""&st="",[#[case_number]])"
Const LINK2 = "HYPERLINK(""https://open.companytest.com/janesfakeurl.aspx?rdx=9992956J43211&help=""&[#[case_number]]&""&st="",[#[case_number]])"
Dim ws As Worksheet, lo As ListObject, lc As ListColumn
Set ws = ActiveSheet
Set lo = ws.ListObjects(1)
lo.Name = "Drilldown"
Set lc = lo.ListColumns.Add(Position:=4)
lc.Name = "CaseLink"
lc.DataBodyRange.Formula = "=IF([#[link_type]]=""CSv2""," & LINK1 & "," & LINK2 & ")"
lo.Range.EntireColumn.AutoFit
End Sub
As there were only two values possible in Column A, I was able to resolve with a simple single line IF statement:
ActiveCell.FormulaR1C1 = _
"=IF(RC[-3]=""CSv1"",HYPERLINK(CONCATENATE(""https://open.companytest.com/fredsfakeurl.aspx?rdx=9992956J43211&conv="",RC[-2]),RC[-2]),HYPERLINK(CONCATENATE(""https://open.companytest.com/janesfakeurl.aspx?conv="",RC[-2]),RC[-2]))"

Excel VBA reconciliation

I have excel workbook and i need to compare column B and column W if column B & W data is the same need to copy an entire row to a newsheet(sheetname "Reconciled") column B data is date format like this (2020-02-01 07:55:08.0) column W date format is like this (27/01/2020) Column B & W need to compare with the date.
this code date is selected but it is working but it is wrong.
Sub runThrough(cbpath As String, bspath As String)
Dim newcashBook, newbankstmt As Worksheet
Dim cashbook, Bankstmt As Workbook
Dim i, j As Long
Dim cbRecords, bsRecords rng As String
Set cashbook = Workbooks.Open(cbpath)
'copy data from another workbook
Set newcashBook = cashbook.Sheets(1)
newcashBook.Range("A1:Z1048576").Copy
cashbook.Close
'paste data to W1 row from another workbook
Set newbankstmt = ThisWorkbook.Sheets("Sheet0")
newbankstmt.Range("W1").PasteSpecial
For i = 2 To 100
Set newbankstmt = ThisWorkbook.Sheets("Sheet0")
' Sheet0 is activeworkbook active worksheet
Rows.Cells(i, 2).Select
Rows.Cells(i, 2).Select
For j = 2 To 100
Rows.Cells(j, 31).Select
If (i = j) Then
Debug.Print "yes" 'check data same or not
Else
Debug.Print "wrong"
End If
Next j
Next i
End Sub
The below check if both date are valid and check if there are the same. Modify and use:
Sub populate_sales()
Dim bDate As Date, wDate As Date
With ThisWorkbook.Worksheets("Sheet1")
'Check if both date are valid
If IsDate(.Range("B1").Value) And IsDate(.Range("W1").Value) Then
bDate = Year(.Range("B1").Value) & "-" & Right("0" & Month(.Range("B1").Value), 2) & "-" & Right("0" & Day(.Range("B1").Value), 2)
wDate = Year(.Range("W1").Value) & "-" & Right("0" & Month(.Range("W1").Value), 2) & "-" & Right("0" & Day(.Range("W1").Value), 2)
If bDate = wDate Then
'Copy
End If
Else
MsgBox "Invalid dates"
End If
End With
End Sub
I prepared a code based on what I could deduce from your question and comments. So, the code copy, as fast as possible (using array) the content of cashbook.Sheets(1) in newbankstmt.Range("W1").
Then it iterates between 100 rows and, if "B" cell Date on a specific row is equal with the "W" cell Date of the same row, then the rage "A:W" address of the respective row is returned in Immediate Window and the code is stopped. You can go to the next such occurrence pressing F5. In order to see the returned value in Immediate Window, you must press Ctrl + G.
If this is what you needed, please confirm and I will show you how that ranges can be also loaded in another array and paste at once in a new sheet, or wherever you need, if clearly explain where...
This code doesn't care about the cell (date) format. But, the code would work only if both cells in discussion (B and W) are of Date type.
Sub runThrough(cbpath As String, bspath As String)
Dim newcashBook As Worksheet, newbankstmt As Worksheet
Dim cashbook As Workbook, Bankstmt As Workbook
Dim i As Long, dateB As Date, dateW As Date, arrC As Variant
Set cashbook = Workbooks.Open(cbpath)
'copy data from cashbook:
Set newcashBook = cashbook.Sheets(1)
'input the big range in arrC array:
arrC = newcashBook.Range("A1:Z1048576").value
cashbook.Close
'copy the arrC content starting from W1:
Set newbankstmt = ThisWorkbook.Sheets("Sheet0")
newbankstmt.Range("W1").Resize(UBound(arrC, 1), UBound(arrC, 2)).value = arrC
For i = 2 To 100 'why To 100?
dateB = newbankstm.Cells(i, "B").value
dateW = newbankstm.Cells(i, "W").value
If DateSerial(Year(dateB), Month(dateB), Day(dateB)) = DateSerial(Year(dateW), Month(dateW), Day(dateW)) Then
Debug.Print "Range to be copied: " & newbankstm.Range(newbankstm.Cells(i, 1), _
newbankstm.Cells(i, "W")).Address
Stop
End If
Next i
End Sub

How to compare values between rows

I need help here. I have a spreadsheet that has more than 6K datas. I need to compare the values between the "MOVE_IN_QTY" and "MOVE_OUT_QTY" by using VBA. The problem here is I need to compare the value right after the code has changed from "CV64" and "TW78" in the code column. The value I have higlighted in red and the code I have highlighted in blue and yellow. I would appreciate any help. Thanks.
Making a few assumptions here:
Move In & Move Out are always numbers.
Move numbers are compered using the =,<,> process.
Unknown further action based on result is required.
Also it helps to include what you have tried and what is not working.
Sub ReviewData()
Dim wkbk As Workbook
Dim xsheet As Worksheet
Dim codeColumn As String, moveIN As String, moveOUT As String
Dim rowCount As Double
Set wkbk = ThisWorkbook
Set xsheet = wkbk.Worksheets("Sheet1") 'change sheet name here
codeColumn = "B" ' change column letter here
moveIN = "C" 'set move in column
moveOUT = "D" 'set move out column
'this will loop through the Code column until the last set of data.
rowCount = xsheet.Range(codeColumn & xsheet.Rows.Count).End(xlUp).Row 'find last row
For x = 2 To rowCount
'checks if code transitions from one code to another
If not xsheet.Range(codeColumn & x).Value = xsheet.Range(codeColumn & x + 1).Value Then
If xsheet.Range(moveIN & x).Value = xsheet.Range(moveOUT & x + 1).Value Then
'do something if the code is the same
Else
xsheet.Range(codeColumn & x).Interior.ColorIndex = 3
MsgBox ("Row: " & x & " is different") 'comment this out not to get the message
End If
Else
End If
Next x
End Sub

Finding if a cell values (delimited by comma) are all existing in a defined table

Here is a sample of the report I have:
Basically the report consists in a huge list of suppliers where among other things, I need to identify which of them have all entities (content groups) for the same country, while ignoring the "integrate" tag. Entities for each country are defined in a table separately (right).
So far I tried a combination of =SUMPRODUCT(--(ISNUMBER(SEARCH())) but always getting partially what I want.
In column C, in need:
to display YES if the supplier on that row has all entities for the mentioned country code;
to display NO otherwise;
My logic on this:
The formula/s needs to pick the country code from 1st table, then look into the 2nd table where entities are defined and check if all the entities in the content group are matching, ignoring "integrate" which is a default tag applied everywhere.
Expected result:
Try:
Option Explicit
Sub test()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim LastRowA As Long, i As Long, y As Long
Dim arr As Variant
Dim CountryCode As String
Dim rng As Range, SearchRange As Range, FindPosition As Range
Dim Appears As Boolean
'Set worksheets on variables
With ThisWorkbook
Set ws1 = .Worksheets("Sheet1")
Set ws2 = .Worksheets("Sheet2")
End With
'Set the range to search in for country codes
Set SearchRange = ws2.Range("H1:R1")
With ws1
'Find the last row of Column A sheet1
LastRowA = .Cells(.Rows.Count, "A").End(xlUp).Row
'Start loop from row 2 to last row sheet1
For i = 2 To LastRowA
'Criteria needed ( Column A - Not empty cell, Column D - Includes "Europe" & Column E - Includes "No" Columns D and E are CASE SENSITIVE)
If .Range("A" & i).Value <> "" And .Range("D" & i).Value = "Europe" And .Range("E" & i).Value = "No" Then
CountryCode = .Range("B" & i).Value
'In which column the country code found
Set FindPosition = SearchRange.Find(What:=CountryCode, LookIn:=xlValues, LookAt:=xlWhole)
'If code excist
If Not FindPosition Is Nothing Then
'Set the range to search for the groups in the column where the code is header
Set rng = ws2.Range(ws2.Cells(2, FindPosition.Column), ws2.Cells(ws2.Cells(ws2.Rows.Count, FindPosition.Column).End(xlUp).Row, FindPosition.Column))
'Split the string with comma and assing it on arr
arr = Split(.Range("A" & i).Value)
Appears = False
'Loop the arr
For y = LBound(arr) To UBound(arr)
'Check if the arr(y) start from C as all code start from C
If Left(arr(y), 1) = "C" Then
'Count how many times the arr(y) with out the comma appears in the rng
If Application.WorksheetFunction.CountIf(rng, Replace(arr(y), ",", "")) > 0 Then
'If appears the variable Appears is true
Appears = True
Else
'If does not appear the variable Appears is False & Exit the loop
Appears = False
Exit For
End If
End If
Next y
'Check Appears variable status and import value in Column C
If Appears = True Then
.Range("C" & i).Value = "Yes"
Else
.Range("C" & i).Value = "No"
End If
'If code does not excist
Else: MsgBox "Country Code not does not excist."
End If
End If
Next i
End With
End Sub
If you have a version of Excel 2013+ which has the FILTERXML function, you can use this array formula:
=IF(OR(ISNA(MATCH(FILTERXML("<t><s>"&SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(A2,"Integrate",""),", ",","),",","</s><s>")&"</s></t>","//s"),INDIRECT("Table2["&B2&"]"),0))),"No","Yes")
We remove the Integrate
Create an XMLfrom the strings in Table1
Extract each element of the XML
Try to find them in the appropriate column of Table2
If we don't find one, then it has multiple countries.
Since this is an array formula, you need to "confirm" it by holding down ctrl + shift while hitting enter. If you do this correctly, Excel will place braces {...} around the formula as observed in the formula bar
If you have a version of Excel that does not have this function, and you are still interested in using excel formulas as opposed to VBA, there is another formula we can use.

Dynamic Logic in Excel Vba

I have a excel workbook which has 30 worksheets in it. Each sheet looks something like this
Now i want to insert a column after "I" column (the new column will be J)and the values should be some thing like this
for coupon 2.000(4-7 rows) the values in the new column J should be = i4-i5(For all J4,5,6,7)
This should be repeated for each coupon.
I tried recording the macro but did not help.
Please provide me sample logic to handle this dynamically.
Thank you in advance.
From your description, it sounded like this is what you are looking for. Please let me know if that is not the case.
Sub AddNewColumn()
Dim sColumnToIns, sCouponField, sCouponGroup, _
sFormula, sCell1, sCell2, sMarketValueField, sColumnToInsHeader, sTopCellOfData
Dim rData As Range
Dim rRng As Range
Dim rCell As Range
Dim oSh As Worksheet
'Make sure you change the sheet to reflect
'the object name of your sheet.
Set oSh = Sheet2
sColumnToIns = "J"
sColumnToInsHeader = "New Column"
sCouponField = "B"
sMarketValueField = "I"
sTopCellOfData = "A4"
'Insert a new column
Sheet1.Range(sColumnToIns & ":" & sColumnToIns).Insert xlShiftToRight
'Get lowest cell in used range
Set rRng = oSh.UsedRange.Cells(oSh.UsedRange.Rows.Count, oSh.UsedRange.Columns.Count)
Set rData = oSh.Range(sTopCellOfData, rRng)
'Set the header text
rData.Range(sColumnToIns & "1").Offset(-1).Value = sColumnToInsHeader
'Go through the entire data set. Whenever the value in the 'Coupon'
'column changes, put a formula the subtracts the top market value
'from the next market value down.
sCouponGroup = ""
For Each rCell In rData.Columns(sCouponField).Cells
If sCouponGroup <> rCell.Value Then
sCouponGroup = rCell.Value
sCell1 = rCell.EntireRow.Columns(sMarketValueField).Address
sCell2 = rCell.EntireRow.Columns(sMarketValueField).Offset(1).Address
sFormula = "=" & sCell1 & "-" & sCell2
End If
rCell.EntireRow.Columns(sColumnToIns).Formula = sFormula
Next
End Sub

Resources