I got stuck on how to implement the logic dynamically.
i'm referencing the source sheet to main page sheet for the cells ranging from c5 to c12, similarly for other cells, eg. n5 to n12.
Sub cellRef()
Dim srcSht As Worksheet, destSht As Worksheet
Set srcSht = ThisWorkbook.Sheets("HR - Source")
Set destSht = ThisWorkbook.Sheets("HR - Main Page")
destSht.Range("C5").Formula = "='" & srcSht.Name & "'!C5"
destSht.Range("C6").Formula = "='" & srcSht.Name & "'!C6"
destSht.Range("C7").Formula = "='" & srcSht.Name & "'!C7"
destSht.Range("C8").Formula = "='" & srcSht.Name & "'!C8"
destSht.Range("C11").Formula = "='" & srcSht.Name & "'!C11"
destSht.Range("C12").Formula = "='" & srcSht.Name & "'!C12"
destSht.Range("N5").Formula = "='" & srcSht.Name & "'!N5"
destSht.Range("N6").Formula = "='" & srcSht.Name & "'!N6"
destSht.Range("N7").Formula = "='" & srcSht.Name & "'!N7"
destSht.Range("N8").Formula = "='" & srcSht.Name & "'!N8"
destSht.Range("N11").Formula = "='" & srcSht.Name & "'!N11"
destSht.Range("N12").Formula = "='" & srcSht.Name & "'!N12"
destSht.Range("M5").Formula = "='" & srcSht.Name & "'!M5"
destSht.Range("M6").Formula = "='" & srcSht.Name & "'!M6"
destSht.Range("M7").Formula = "='" & srcSht.Name & "'!M7"
destSht.Range("M8").Formula = "='" & srcSht.Name & "'!M8"
destSht.Range("M11").Formula = "='" & srcSht.Name & "'!M11"
destSht.Range("M12").Formula = "='" & srcSht.Name & "'!M12"
end sub```
how to make it dynamic, using any loops?
please suggest.
Related
I want change the columns AN, Z, AD from text to the column number which I will store as a integer variable.
AChart.SeriesCollection.NewSeries
AChart.FullSeriesCollection(iCollection).Name = "=" & "'" & ws.Name & "'" & "!$AN$" & iStart
AChart.FullSeriesCollection(iCollection).XValues = "=" & "'" & ws.Name & "'" & "!$Z$" & iStart & ":$Z$" & iEnd
AChart.FullSeriesCollection(iCollection).Values = "=" & "'" & ws.Name & "'" & "!$AD$" & iStart & ":$AD$" & iEnd
I tried "!C" & variable name but that didn't work.
Please help
Thanks
Dan
I am trying to loop through the Headers of the Table and then populate the formula as mentioned below:
Dim headerRng As Range
For Each headerRng In IndMetricsSht.ListObjects(TableName2).Range.Rows(1).Cells
Debug.Print headerRng
If headerRng.Value <> "Function" And headerRng.Value <> "Team Members" And headerRng.Value <> "Accuracy %" Then
IndMetricsSht.ListObjects(TableName2).ListColumns(headerRng.Value).DataBodyRange.Select
Selection.FormulaR1C1 = "=SUMIFS(INDIRECT(" & Chr(34) & TableName & Chr(34) & " & ""["" & [#[Team Members]] & CHAR(10) & ""Volumes"" & ""]"")," & Chr(34) & TableName & Chr(34) & " & ""["" & [#[Sub-Function]] & ""]"",LEFT(" & Chr(34) & headerRng.Value & Chr(34) & ",FIND(""_""," & Chr(34) & headerRng.Value & Chr(34) & ")-1))" 'I'm facing error (application object error)
End If
Next
Actual formula in Excel sheet looks like:
=SUMIFS(INDIRECT("IM_012022" & "[" & [#[Team Members]] & CHAR(10) & "Volumes" & "]"),IM_012022[Sub-Function],LEFT(Consolidated_012022[[#Headers],[Corporate Treasury_Volumes]],FIND("_",Consolidated_012022[[#Headers],[Corporate Treasury_Volumes]])-1))
I'm trying to replicate the same formula for each header using the loops concept, but somwhere in that formula, I'm missing.
Dim HeaderRng As Range
For Each HeaderRng In IndMetricsSht.ListObjects(TableName2).Range.Rows(1).Cells
Debug.Print HeaderRng
If HeaderRng.Value <> "Function" And HeaderRng.Value <> "Team Members" And HeaderRng.Value <> "Volumes" And Not (HeaderRng.Value Like "*Errors") And HeaderRng.Value <> "Accuracy %" Then
IndMetricsSht.ListObjects(TableName2).ListColumns(HeaderRng.Value).DataBodyRange.Select
Selection.FormulaR1C1 = "=SUMIFS(INDIRECT(" & Chr(34) & TableName & Chr(34) & " & ""["" & [#[Team Members]] & CHAR(10) & ""Volumes"" & ""]""),INDIRECT(" & Chr(34) & TableName & Chr(34) & " & ""[Sub-Function]""),LEFT(" & Chr(34) & HeaderRng.Value & Chr(34) & "," & InStr(1, HeaderRng.Value, "_") - 1 & "))"
End If
Next
Column A contains part numbers such as 499305 and 488212
Sub ProductLoopChemSafe()
Dim X As Integer
Dim lRow As Long
Image1 = 250
Image2 = 500
Image3 = 5000
lRow = Cells(Rows.Count, 1).End(xlUp).Row
For X = 3 To lRow
Range("B" & X).Value = "http://www.chemsafeint.com/images/products/" & Image1 & "/" & Range("A" & X).Value & ".gif"
Range("C" & X).Value = "http://www.chemsafeint.com/images/products/" & Image2 & "/" & Range("A" & X).Value & ".gif"
Range("D" & X).Value = "http://www.chemsafeint.com/images/products/" & Image3 & "/" & Range("A" & X).Value & ".gif"
Range("E" & X).Value = "http://www.chemsafeint.com/files/sds/" & Range("A" & X).Value & ".pdf"
Range("F" & X).Value = "http://www.chemsafeint.com/files/pds/" & Range("A" & X).Value & ".pdf"
Range("G" & X).Value = "http://www.chemsafeint.com/files/idf/" & Range("A" & X).Value & ".pdf"
If Range("A" & X) = "17255" Then
Range("H" & X).Value = "http://www.chemsafeint.com/files/eds/" & Range("A" & X).Value & ".pdf"
End If
If Range("A" & X) = "17418" Then
Range("I" & X).Value = "http://www.chemsafeint.com/files/epp/" & Range("A" & X).Value & ".pdf"
End If
If Range("A" & X) = "17750" Then
Range("I" & X).Value = "http://www.chemsafeint.com/files/epp/" & Range("A" & X).Value & ".pdf"
End If
If Range("A" & X) = "17822" Then
Range("I" & X).Value = "http://www.chemsafeint.com/files/epp/" & Range("A" & X).Value & ".pdf"
End If
Next X
End Sub
How can I test to see if a path is valid before I write it?
I'd like to do something like:
DIM Bvalue as string
Bvalue = "http://www.chemsafeint.com/images/products/" & Image1 & "/" & Range("A" & X).Value & ".gif"
If Bvalue is valid then
Range("B" & X).value = Bvalue
Else
Range("B" & X).value = ""
END IF
You can write a function that receive the URL as parameter and validate it with some web-scraping code then returns true or false if the object of the link is valid. something like isObject( html_element )
The HTML element could be an element that loads everytime when the stuff that you are searching exists. For example the following URL https://chemsafeint.com/images/products/500/11999-DM55.gif has the object img inside the HTML code ( if you are not familiar please search Web Scraping with VBA ), then you can try this:
Function isValid ( byVal URL as string )as boolean
'URL is the link that you have just mounted concatenating strings.
Dim IE As InternetExplorer: Set IE = New InternetExplorer
IE.navigate URL
IE.AddressBar = False
IE.Visible = True
Set IEDOC = IE.document
Dim ELE as HTMLImage
Set ELE = IEDOC.getElementsByTagName("img")
if isObject(ELE) then
isValid = true
else
isValid = false
end if
IE.Quit
Set IE = NOTHING
Exit Function
FilesCheck with multiple filename and turn green color in the cell.
Return at Cell C5
Found = Dir(FolderPath & "\" & "01 - Introduction" & " " & Range("B5") & "_v" & Range("B3") & ".*")
Found1 = Dir(FolderPath & "\" & "02 - Business" & " " & Range("B5") & "_v" & Range("B3") & ".*")
Found2 = Dir(FolderPath & "\" & "04 - Linking" & " " & Range("B5") & "_v" & Range("B3") & ".*")
Found3 = Dir(FolderPath & "\" & "05 - Data" & " " & Range("B5") & "_v" & Range("B3") & ".*")
Found4 = Dir(FolderPath & "\" & "06 - Conclusion" & " " & Range("B5") & "_v" & Range("B3") & ".*")
Found5 = Dir(FolderPath & "\" & "Systems_ABC" & "_v" & Range("B3") & ".*")
If Found <> "" & Found1 <> "" & Found2 <> "" & Found3 <> "" & Found4 <> "" & Found5 <> "" Then
Range("C5").Interior.ColorIndex = 4
Else
Range("C5").Interior.ColorIndex = 3
End If
the code are not working, even I change the filename, the cell still will return green color.
Change this:
If Found <> "" & Found1 <> "" & Found2 <> "" & Found3 <> "" & Found4 <> "" & Found5 <> "" Then
Range("C5").Interior.ColorIndex = 4
Else
Range("C5").Interior.ColorIndex = 3
End If
With This:
If Found <> "" And Found1 <> "" And Found2 <> "" And Found3 <> "" And Found4 <> "" And Found5 <> "" Then
Range("C5").Interior.ColorIndex = 4
Else
Range("C5").Interior.ColorIndex = 3
End If
And is accepted like this. Also I am assuming that your DIR are all working fine.
I have a master spreadsheet that analyzes records from another spreadsheet with rows going all the way up to 1.4 million.
Below are the relevant pieces from the code:
Sub Whyamidoingthis()
Dim USISINLfp As String
Dim ISINL As String
Dim echeck As String
Dim wUSISIN As Workbook
Dim lastrow As Long
Dim Result As Worksheet
Dim i As Long
Set OutShVar = ThisWorkbook.Worksheets("in1")
ISINL = "CONSOLIDATED - Country_Of_Incorp_US_2019-03-01 (Consolidated).xlsx"
USISINLfp = "W:\Product Platforms\ISIN- CUSIP Country of Incorporation\March 2019\"
Workbooks.Open (USISINLfp & ISINL)
Set wUSISIN = Workbooks(ISINL)
With Result
lastrow = .Cells(.Rows.Count, "H").End(xlUp).Row
End With
'US Security 1
For i = 2 To lastrow
With Result
echeck = Trim(.Range("O" & i))
If echeck = "" Then
.Range("P" & i & ":Q" & i).Value = "N"
Else
.Range("P" & i).Value = "=ifna(vlookup(O" & i & "," & ISINL & "First Sheet'!$B:$C,2,false)," & Chr(34) & "N" & Chr(34) & ")"
.Range("Q" & i).Value = "=ifna(vlookup(O" & i & "," & ISINL & "Second Sheet'!$B:$C,2,false)," & Chr(34) & "N" & Chr(34) & ")"
'Debug.Print "=ifna(vlookup(O" & i & "," & ISINL & "Second Sheet'!$B:$C,2,0)," & Chr(34) & "N" & Chr(34) & ")"
End If
'US Security 2
echeck = Trim(.Range("S" & i))
If echeck = "" Then
.Range("T" & i & ":U" & i).Value = "N"
Else
.Range("T" & i).Value = "=ifna(vlookup(S" & i & "," & ISINL & "First Sheet'!$A:$C,3,false)," & Chr(34) & "N" & Chr(34) & ")"
.Range("U" & i).Value = "=ifna(vlookup(S" & i & "," & ISINL & "Second Sheet'!$A:$C,3,false)," & Chr(34) & "N" & Chr(34) & ")"
End If
End With
Next I
If Not wUSISIN Is Nothing Then wUSISIN.Close savechanges:=False
End Sub
The code is getting stuck at the following line:
.Range("T" & i).Value = "=ifna(vlookup(S" & i & "," & ISINL & "First Sheet'!$A:$C,3,false)," & Chr(34) & "N" & Chr(34) & ")"
Whenever a result is found and the error is application defined error.
Try this formula:
"=ifna(vlookup(O" & i & ",'[" & ISINL & "]First Sheet'!$B:$C,2,false)," & Chr(34) & "N" & Chr(34) & ")"
This places square brackets around the workbook name and single quotes around the workbook-worksheet combo. See this tutorial about using VLOOKUP from another workbook.