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]))"
Related
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.
I am trying to loop through all rows (there is 1000's of rows) in column 'AQ' and if value = "Salary Sacrifice" then I want to display "SALSC" in column 'AP' same row. Here is my code I have so far:
Dim payCodeDescription As String
Dim paycodevalue As String
payCodeDescription = Range("AQ52").Value
If payCodeDescription = "Salary Sacrifice" Then paycodevalue = "SALSC"
ElseIf payCodeDescription = "GrossPay-Overpaid" Then paycodevalue = "OVERP"
End If
Range("AP52").Value = paycodevalue
Is there any way I could turn this into a loop instead of hard coding?
I would use this if formuala...
=IF(AQ52="Salary Sacrifice","SALSC",IF(AQ52="GrossPay-Overpaid","OVERP",""))
but this replaces the values if the condition is false and I need it to do nothing if the value is false.
Any help would be greatly appreciated.
If you are still looking to use VBA, something like the code below will help:
Sub LoopThroughRows()
Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Sheet1")
'declare and set the worksheet you are working with, amend as required
LastRow = ws.Cells(ws.Rows.Count, "AQ").End(xlUp).Row
'get the last row with data on Column AQ
For i = 2 To LastRow
'loop from row 2 to the Last row
If ws.Cells(i, "AQ").Value = "Salary Sacrifice" Then ws.Cells(i, "AP").Value = "SALSC"
If ws.Cells(i, "AQ").Value = "GrossPay-Overpaid" Then ws.Cells(i, "AP").Value = "OVERP"
'process your conditional statements
Next i
'next row
End Sub
The faster method as mentioned in the comments would be Filtering the data instead of looping through individual rows, the code below is an example of that:
Sub FilterRows()
Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Sheet4")
'declare and set the worksheet you are working with, amend as required
ws.Cells.AutoFilter
If ws.FilterMode = True Then ws.AutoFilter.ShowAllData
'apply Autofilter and make sure we show all data
LastRow = ws.Cells(ws.Rows.Count, "AQ").End(xlUp).Row
'get the last row with data on Column AQ
ws.Range("$A$1:$AQ$" & LastRow).AutoFilter Field:=43, Criteria1:="Salary Sacrifice"
'filter by Criteria on Column 43, AQ
ws.Range("AP2:AP" & LastRow).SpecialCells(xlCellTypeVisible).Value = "SALSC"
'fill visible rows in Column AP with the desired text
ws.Range("$A$1:$AQ$" & LastRow).AutoFilter Field:=43, Criteria1:="GrossPay-Overpaid"
ws.Range("AP2:AP" & LastRow).SpecialCells(xlCellTypeVisible).Value = "OVERP"
If ws.FilterMode = True Then ws.AutoFilter.ShowAllData
'clear the Filter to show all data again.
End Sub
I have an excel sheet with around 200 work sheets each containing a list of products sold to a company.
I need to add
A total at the bottom of row D-G where the bottom can be a different value. I.E. E4
below the total a formula based on the total. I.E. if E4 (being the bottom of the above row) is below $999 the display text "samples", if between 1000-3000 then multiply E4 by 2%, 3001-7500 x 5% etc.
I need to be able to add it to the entire workbook easily using vba. Since I must do this to numerous ss it would literally save me 15-20 hours a month.
Edit:
So I have something that seems to be the right path.
Sub Split_Worksheets()
Dim rRange As Range, rCell As Range
Dim wSheet As Worksheet
Dim wSheetStart As Worksheet
Dim strText As String
Set wSheetStart = ActiveSheet
wSheetStart.AutoFilterMode = False
'Set a range variable to the correct item column
Set rRange = Range("A1", Range("A65536").End(xlUp))
'Delete any sheet called "UniqueList"
'Turn off run time errors & delete alert
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("UniqueList").Delete
'Add a sheet called "UniqueList"
Worksheets.Add().Name = "UniqueList"
'Filter the Set range so only a unique list is created
With Worksheets("UniqueList")
rRange.AdvancedFilter xlFilterCopy, , _
Worksheets("UniqueList").Range("A1"), True
'Set a range variable to the unique list, less the heading.
Set rRange = .Range("A3", .Range("A65536").End(x2Up))
End With
On Error Resume Next
With wSheetStart
For Each rCell In rRange
strText = rCell
.Range("A1").AutoFilter 1, strText
Worksheets(strText).Delete
'Add a sheet named as content of rCell
Worksheets.Add().Name = strText
'Copy the visible filtered range _
(default of Copy Method) and leave hidden rows
.UsedRange.Copy Destination:=ActiveSheet.Range("A1")
ActiveSheet.Cells.Columns.AutoFit
Next rCell
End With
With wSheetStart
.AutoFilterMode = False
.Activate
End With
On Error GoTo 0
Application.DisplayAlerts = True
Dim colm As Long, StartRow As Long
Dim EndCell As Range
Dim ws As Worksheet
StartRow = 3
For Each ws In Worksheets
Set EndCell = ws.Cells(Rows.Count, "c").End(xlUp).Offset(1, 1)
If EndCell.Row > StartRow Then EndCell.Resize(, 4).Formula = "=SUM(R" & StartRow & "C:R[-1]C)"
Set EndCell = ws.Cells(Rows.Count, "D").End(xlUp)
If EndCell.Row >= 1000 Then
Range(J2) = Formula = ((EndCell.Row) * (0.05))
Range(J3) = "5% Discount"
ElseIf EndCell.Row >= 3000 Then
Range(J2) = Formula = ((EndCell.Row) * (0.1))
Range(J3) = "10% Discount"
End If
Next ws
End Sub'
Just need to figure out how to display the results and text to the right cells (J2 in this case)
I will supply the logic and all the references you need to put this one together; and will let you try to put it together on your own :). Come back for more help if needed.
You need to loop through all the worksheets in your workbook (Microsoft Tutorial)
You need to find the last row for the given columns (Online tutorial)
You need to use an IF statement to choose which formula to use (MSDN reference)
UPDATE
What's wrong with your code is this line :
Range(J2) = Formula = ((EndCell.Row) * (0.1))
What you're telling the computer is :
Multiply EndCell.Row by 0.1 (which has the number of the row below and to the right of the last cell in column C)
Compare Formula with the result previously obtained
Store the result of that logical expression at the range stored in variable J2
First of all, what you want is to put the result of the equation, and want to change J2 to "J2" so it gets the cell J2, instead of the what's contained in J2 (which has nothing at that point)
Also, you seem to say that you're not getting the right cells, maybe it is caused by this :
Set EndCell = ws.Cells(Rows.Count, "c").End(xlUp).Offset(1, 1)
In that line, you're finding the last cell of column C, but then you select the cell below, and to the right of it.
There are so many things wrong with your code it's hard to say what's not working properly.
I have a quandary, and I don't know if it will work better using excel VBA or not. Thinking about it I believe VBA will work best, but I don't know how to make it work.
I have two pages in a workbook, one is the form, the other is the database, I want the pulldown menu from the form to populate the rest of the form. It does... what I want then is to be able to change the value of the form press submit, and the new data will overwrite the old data.
Is this possible?
Here is the link to the sheet I'm talking about.
http://dl.dropbox.com/u/3327208/Excel/Change.xlsx
Here is the script I am working with now...it takes the sheet, copies everything to a row takes that row, moves it to the NCMR Data tab and then clears the data on the new row from the original sheet.
This code technically could work, but what I need to do is make it use the same concept, but instead of creating a new row at the end of the sheet find the original line and replace the data from B to U in whatever row it was originally in.
I know it's possible, I just don't know how.
'Copy Ranges Variable
Dim c As Variant
'Paste Ranges Variable
Dim p As Range
'Setting Sheet
Set wsInt = Sheets("Form")
Set wsNDA = Sheets("Data")
Set p = wsInt.Range("A14")
With wsInt
c = Array(.Range("B11"))
End With
For i = LBound(c) To UBound(c)
p(i + 1).Value = c(i).Value
Next
With wsNDA
Dim Lastrow As Long
Lastrow = .Range("B" & Rows.Count).End(xlUp).Row + 1
wsInt.Rows("14").Copy
With .Rows(Lastrow)
.PasteSpecial Paste:=xlPasteFormats
.PasteSpecial Paste:=xlPasteValues
.Interior.Pattern = xlNone
End With
With .Range("A" & Lastrow)
If Lastrow = 3 Then
.Value = 1
Else
.Value = Val(wsNDA.Range("A" & Lastrow - 1).Value) + 1
End If
.NumberFormat = "0#######"
End With
End With
End Sub
I found this code:
Sub CopyTest()
Dim selrow As Range, rngToCopy As Range
With Worksheets("PD DB")
Set selrow = .Range("B:B").Find(.Range("BA1").Value)
'find the cell containing the value
Set rngToCopy = Union(selrow.Offset(0, 9), selrow.Offset(0, 12))
'use offset to define the ranges to be copied
rngToCopy.Copy Destination:=Worksheets("Edit Sheet").Range("B50")
'copy and paste (without Select)
End With
End Sub
As far as I can tell this will do what I want mostly, but I can't seem to figure out where to break it up to add it where I need to to make it work the way I want it to.
What I can tell is this, it will copy and paste, but I want to make sure it will paste the data into row it finds, and not overwrite the number of said row.
Can someone help make that possible with the two scripts I have here?
Not tested, but should get you started. I added a 3rd sheet (shtMap) to hold the mmapping between the cell addresses on your form and the column numbers on the "Data" sheet. Useful to name your sheets directly in the VB editor: select the sheet and set the name in the property grid.
*EDIT:*If you want to trigger the transfer on selecting a record id from a list in Range AG3 then place this code in the code module for that worksheet:
Private Sub Worksheet_Change(ByVal Target As Range)
Static bProcessing As Boolean
Dim rng As Range
If bProcessing Then Exit Sub
Set rng = Target.Cells(1)
If Not Application.Intersect(rng, Me.Range("AG3")) Is Nothing Then
bProcessing = True
'this is where you call your macro to transfer the record
bProcessing = False
End If
End Sub
You could use something like this for the transfer:
Public Enum XferDirection
ToForm = 1
ToDataSheet = 2
End Enum
Sub FetchRecord()
TransferData XferDirection.ToForm
End Sub
Sub SaveRecord()
TransferData XferDirection.ToDataSheet
End Sub
Sub TransferData(Direction As XferDirection)
Dim rngMap As Range, rw As Range, f As Range, dataCell As Range
Dim formCell As Range, dataCol As Long, dataRow As Long
Dim sId As String
sId = shtForm.Range("AG3").Value
Set f = shtData.Columns(1).Find(sId, LookIn:=xlValues, lookat:=xlWhole)
If Not f Is Nothing Then
dataRow = f.Row
Else
'what do you want to do here?
' record doesn't exist on data sheet
MsgBox "Record '" & sId & "' not found on '" & shtForm.Name & "' !"
Exit Sub
End If
Set rngMap = shtMap.Range("A2:B10")
For Each rw In rngMap.Rows
'the cell on the edit form
Set formCell = shtForm.Range(rw.Cells(1).Value)
'column # on datasheet
Set dataCell = shtData.Cells(dataRow, rw.Cells(2).Value)
If Direction = XferDirection.ToDataSheet Then
dataCell.Value = formCell.Value
Else
formCell.Value = dataCell.Value
End If
Next rw
End Sub
Matt, there are two approaches I would take. The first is use find(), which returns a range object, then append ".row" so that you'll be able to modify the row on Sheet2 (wsNDA, I think). You may want to test that find() doesn't return Nothing.
Dim foundRow as Long
Dim foundRng as Range
set foundRng = wsNDA.find(wsInt.Range("B11").Value, ...)
If Not foundRng is Nothing Then
foundRow = foundRng.row
End If
'method without check: foundRow = wsNDA.find(wsInt.Range("B11").Value, ...).Row
The other is to use a Dictionary object. I'm not sure what you'd want for the key, but the item could be the row on the data sheet. When you make the change to what's on the form, check against the key and grab its item (the corresponding row) to determine where you need to replace the values.
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