I have an excel document with ~300 similar worksheets and 1 worksheet with a list of names. Each of these 300 worksheets has a specific cell where I need to fill a name from the list. The list and the sheets are in the same order (for example sheet1 needs a name from List!C1, sheet2 from List!C2 etc). I looked into VLOOKUP, but there isn't any reference data I can use.
I think for similar task you need use VBA Macros like this:
Sub DataFromList()
Dim nameSht As String: nameSht = "List"
Dim shtList As Worksheet
Set shtList = ThisWorkbook.Worksheets(nameSht)
Dim columnWithData As String: columnWithData = "C"
Dim n%: n = 0 ' start from 1 row (0 + 1)
' specific cell where you need to fill a name from the list
Dim addressForData As String: addressForData = "B2"
For Each sht In ThisWorkbook.Worksheets
If sht.Name <> nameSht Then
n = n + 1
sht.Range(addressForData).Formula = "=" & nameSht & "!" & columnWithData & n
End If
Next sht
End Sub
of course, it possible only if address of "specific cell" same in all sheet
Related
The goal is to use a reference Excel workbook as a database to find matching BoxID and then copy cells D to G in the same row. Finally pasting to another workbook that consists of a single worksheet.
I figured Xlookup would be easiest. In Excel it works but it doesn't in VBA.
Three main questions
How do I open another workbook and then reference all sheets or a specific range through all sheets in a dynamically named workbook to my current activeworkbook?
(e.g. sheets will be named freezer 23, freezer 43, fridge 190 in database.)
The rows of the sheets is variable but the columns stay the same.
Is there a way to do the above but if nothing is found to leave the cell blank?
Is there a way I could simplify this code?
On the left is the database which is going to be the external reference/where the data is coming from and on the right is the output sheet. Where I will be using Xlookup to search for the matching value. column "A" is where the search value will be and output to the next 4 cells.
Sub FreezerPulls()
Dim lastrow, j As Long
lastrow = Cells(Rows.Count, 1).End(xlUp).Row
Dim a As Integer
Dim list As Workbook
Dim frzdatabase As
Dim BoxIDlist, info, BoxIDdatabase, database, databasepath As String
databasepath = ("C:\Users\mikeo\Desktop\DataBaseStandard.xlsm")
Workbooks.Open ("C:\Users\mikeo\Desktop\DataBaseStandard.xlsm")
database = "DataBaseStandard.xlsm"
Set list = ThisWorkbook
list.Activate
Set BoxIDlist = Worksheets("Sheet1").Range("A" & Row.Count).End(xlUp).Row 'emphasized textthis doesn't work
Set BoxIDdatabase = Range("A2:A1500")
Set info = Range("D2:G1500")
a = Application.Worksheets.Count
End Sub
You could do something like this, using Match(). See comments in code
Sub FreezerPulls()
Const DB_PATH As String = "C:\Users\mikeo\Desktop\DataBaseStandard.xlsm"
Dim wbData As Workbook, ws As Worksheet, rw As Range, id, m
Set wbData = Workbooks.Open(DB_PATH, ReadOnly:=True) 'get a reference to the data workbook
'loop each row in the lookup table
For Each rw In ThisWorkbook.Sheets("Sheet1").Range("A17:F40").Rows
id = rw.Cells(1).Value 'Box ID to find
If Len(id) > 0 Then 'any value to look up?
For Each ws In wbData.Worksheets 'loop all worksheets in data workbook
m = Application.Match(id, ws.Columns("A"), 0) 'any match on this sheet ColA?
If Not IsError(m) Then 'no error = match was made on row m
rw.Cells(3).Value = ws.Name 'add freezer name
rw.Cells(4).Resize(1, 3).Value = _
ws.Cells(m, 5).Resize(1, 3).Value 'copy segment, rackID, position
Exit For 'done searching (assumes box id's are unique)
End If
Next ws
End If
Next rw
wbData.Close False
End Sub
I'm currently working on a project on VBA that requires multiple manipulation on data.
So, the main idea of this will be to get the data that I have on "Q1" and paste it 4 times on A (starting at the first blank cell), after that, take the data from "Q2" and do the same until there is no more data on the "Q" column. After there is no more data, the process should stop.
Later on I may need to modify the process, so the value gets pasted only 2 or 3 times instead of 4.
Something like this:
Column Q data:
Expected result:
I think this will do what you want:
Option Explicit
Sub Transpose_Multiplied()
Dim Number_Of_Repetitions As Integer
Dim Input_Column As String
Dim Output_Column As String
' -----------------------------------------------------------
' These are the control variables ....
Number_Of_Repetitions = 4
Input_Column = "Q"
Output_Column = "A"
' -----------------------------------------------------------
Dim WSht As Worksheet
Dim Cell As Range
Dim LastACell As Long
Dim i As Integer
Set WSht = ActiveWorkbook.ActiveSheet
For Each Cell In WSht.Range(Input_Column & "2:" & Input_Column & WSht.Cells(WSht.Rows.Count, Input_Column).End(xlUp).Row)
For i = 1 To Number_Of_Repetitions
LastACell = WSht.Cells(WSht.Rows.Count, Output_Column).End(xlUp).Row
If LastACell = 1 And WSht.Cells(LastACell, Output_Column).Value = vbNullString Then
WSht.Cells(LastACell, Output_Column).Value = Cell.Value
Else
WSht.Cells(LastACell + 1, Output_Column).Value = Cell.Value
End If
Next
Next
End Sub
So, I open up my workbook and leave it open on the Worksheet where the data to be processed is. Then I run the macro from my PERSONAL.XLSB:
The purpose of my macro is to allow a user to select a range in their model that they want to check for hard codes. The macro then prints the worksheet, cell address, and value of the hard code on a summary sheet. The macro currently works great if you're selecting only from one sheet; however, if you extend your selection to multiple sheets, the macro will create multiple sheets instead of just one which it is intended to do. Thank you in advance for your time and help
Set RngCon = Selection.SpecialCells(xlCellTypeConstants, xlNumbers)
Set SumWS = Worksheets.Add
Username = InputBox("Please create a name for the output sheet (i.e. Whs Industry Hard Codes)")
SumWS.Name = Username
x = 1
SumWS.Cells(x, 1) = "Worksheet"
SumWS.Cells(x, 2) = "Address"
SumWS.Cells(x, 3) = "Value"
For Each c In RngCon
x = x + 1
SumWS.Cells(x, 1) = c.Worksheet.Name
SumWS.Cells(x, 2) = c.Address(False, False)
SumWS.Cells(x, 3) = c.Value
Next c
you could do something like that:
Sub test()
Dim SumWS As Worksheet
Dim ws As Worksheet
Dim SelectedSheets() As String
Dim n As Long
Dim i As Long
n = 0
For Each ws In ActiveWindow.SelectedSheets
ReDim Preserve SelectedSheets(n)
SelectedSheets(n) = ws.Name
n = n + 1
Next
Sheets(SelectedSheets(0)).Select
Set SumWS = Worksheets.Add
Debug.Print "Sum Sheet: " & SumWS.Name
For i = LBound(SelectedSheets) To UBound(SelectedSheets)
Debug.Print "Selected Sheet #" & i & ": " & SelectedSheets(i)
Next i
End Sub
In the first for you save the selected sheets in an array. Then you can select one specific sheet and add your sum sheet. The second for shows how to work with the stored information. You can loop the selected sheets to get all values and - if needed - select them again.
credits to Siddharth Rout (Similar case)
Context: New to VBA
Task: I have a contact list in Worksheet1 which contains columns: LastName, FirstName, email, phone #, and several more. I have a second contact list in Worksheet2 (formatted exactly the same) which contains approximately 500 of the 1,000 names found in the Worksheet1 contact list BUT with updated contact information (email, phone #, etc.). I'm trying to write code to find which names are in both worksheets, and for those names, copy the email, phone#, etc. from Worksheet2 (updated information) and paste it into the corresponding location in Worksheet2.
Code: This is what I have so far. It does not work.
Sub UpdateContacts()
Dim Reference As String
Dim Range As Range
Dim ContactList As Worksheet
Dim UpdatedContacts As Worksheet
ContactList = ActiveWorkbook.Sheets("Contact List")
UpdatedContacts = ActiveWorkbook.Sheets("Updated Contacts")
Reference = ContactList.Range("B5", "C5").Value
j = 5
For i = 5 To UpdatedContacts.Cells(Rows.Count, 1).End(xlUp).Row
If UpdatedContacts.Range(Cells(i, 2), Cells(i, 3)).Value = Reference Then
UpdatedContacts.Range(Cells(i, 4), Cells(i, 17)).Copy _
Destination:=ContactList.Range(Cells(j, 4), Cells(j, 17))
j = j + 1
End If
Next i
End Sub
Any help is greatly appreciated!
Thanks
Here is a working solution with some minor improvements such as Option Explicit, fully qualified references at all times, Option Compare Text to ignore capital letters when comparing the names, Trim to ignore possible leading or trailing spaces, and creating another outer loop to do the comparison for all names on shtContactList:
Option Explicit
Option Compare Text
Sub UpdateContacts()
Dim ws As Worksheet
Dim rngCell As Range
Dim i As Long, j As Long
Dim strReference As String
Dim shtContactList As Worksheet
Dim shtUpdatedContacts As Worksheet
For Each ws In ThisWorkbook.Worksheets
Select Case ws.Name
Case "Contact List"
Set shtContactList = ws
Case "Updated Contacts"
Set shtUpdatedContacts = ws
Case Else
Debug.Print ws.Name
End Select
Next ws
If shtContactList Is Nothing Or shtUpdatedContacts Is Nothing Then
MsgBox "One or more required sheet(s) were not found." & Chr(10) & "Aborting..."
Exit Sub
End If
For j = 5 To shtContactList.Cells(shtContactList.Rows.Count, "A").End(xlUp).Row
strReference = Trim(shtContactList.Cells(j, 2).Value2) & ", " & Trim(shtContactList.Cells(j, 3).Value2)
For i = 5 To shtUpdatedContacts.Cells(shtUpdatedContacts.Rows.Count, 1).End(xlUp).Row
If Trim(shtUpdatedContacts.Cells(i, 2).Value2) & ", " & Trim(shtUpdatedContacts.Cells(i, 3).Value2) = strReference Then
shtUpdatedContacts.Range(shtUpdatedContacts.Cells(i, 4), shtUpdatedContacts.Cells(i, 17)).Copy _
Destination:=shtContactList.Range(shtContactList.Cells(j, 4), shtContactList.Cells(j, 17))
j = j + 1
End If
Next i
Next j
End Sub
If the code is running slow you might want to consider using an array: (1) put the entire sheet shtUpdatedContacts into an array as well as the sheet shtContactList and (2) then make the search / comparison there. (3) Finally, paste the updates array back to sheet shtContactList.
I have an excel document with over 50 worksheets all with a similar naming convention.
As this will be so unfriendly for users to navigate to, I wrote a VBA macro which creates a worksheet called summary with the list of all the worksheets hyperlinked in a tabular form with Sheet A B and C as the Column and Sheet 1 and 2 as rows.
Now I am trying to go through each row of a specific column in Sheet 1 and Sheet 2 and look for any reference to SheetB, SheetC and SheetD and for each reference found and I want to mark that creating a matrix.
I am not sure how to achieve this. Any assistance will be much appreciated.
I have managed to search Sheet 1 and 2 for any reference to SheetB as shown below but I am not sure how to update the corresponding cell in my summary sheet.
Function findWord(word As String, wSheet As String) As Boolean
Dim LastRow As Long
Dim i As Long
LastRow = Worksheets(wSheet).Cells(Rows.Count, "D").End(xlUp).Row
For i = LastRow To 1 Step -1
If Worksheets(wSheet).Range("D" & i).Value = word Then
findWord = True
Exit Function
End If
Next i
End Function
For Each wsSheet In wbBook.Worksheets
If (wsSheet.Name <> wsActive.Name) And (Left(wsSheet.Name, 4) <> "fact") Then
For i = 2 To lastColumn
MsgBox wsSheet.Name
If findWord(columnNames(counter2), wsSheet.Name) Then
'Update summary sheet
End If
counter = counter2 + 1
Next i
End If
Next wsSheet
If the result in "Summary sheet" you are looking for is similar to this :
Then you can use something like this (read the comments inside the code for explanations)
Sub MarkReferencesToSheets()
Dim wsSummary As Worksheet 'sheet with summary table matrix
Dim wsSheetRow As Worksheet 'sheets in which we will search references to other sheets
Dim strSheetColumnName As String 'name of the reference we are looking for
Dim intSheetRow As Integer 'for loop purposes
Dim intSheetColumn As Integer 'for loop purposes
Set wsSummary = Sheets("Summary")
For intSheetRow = 2 To 3 'change to suit; headers for rows in summary sheet
Set wsSheetRow = Worksheets(wsSummary.Cells(intSheetRow, 1).Value)
For intSheetColumn = 2 To 4 'change to suit; headers for columns in summary sheet
strSheetColumnName = wsSummary.Cells(1, intSheetColumn) 'name of sheet we are looking for
If Not wsSheetRow.Columns(4).Find(strSheetColumnName) Is Nothing Then 'look only in column "D", or 4
wsSummary.Cells(intSheetRow, intSheetColumn) = "X" ' if we found it, mark it
Else
'if you want something else in the cell when reference is not found, put it here
End If
Next intSheetColumn
Next intSheetRow
End Sub