On some difficult issue I am bumped in. And i guess it quite out of my knowledge, and I hope it is even possible to solve on some way.
ISSUE:
Two different workbooks: I am having one workbook with 10 sheets inside, with many formulas, dropdowns, calculations etc., and it is main version of the document which has to be filled with information.
Second workbook, or better to say another similar version to this workbook is like obsolete versions of main wb, where might be possible that some cells/format, or even sheet is missing, but in general almost the same from its structure.
PROCESS:
Sometimes the customers are not having the newest version of excel workbook, but still some of the obsolete versions (they are forgetting to use the newest version), and they are filling those fields inside those older versions and sending them back. The problem is, our ERP Software cant read the obsolete versions, because it is so adjusted to read only the newest version of the document. Meaning, it has to be manually checked every time when the document is sent back and finding discrepancies and copy/paste them into newest version of the document, and then upload it into ERP...
RESULT:
I am looking for some solution, with VBA or even formulas how to check every other workbook against "newest" and if there are any discrepancy and differences just to copy/paste everything from old to new version. When I say "everything" it means, all the fields, sheets, calculations, 1:1.
Unfortunately I am not writing any code or formula, because this is for me super advanced.
On the pic below is one example of one sheet how it looks like. There are lot of columns, calcs and so on.
Explanation:
To clarify bit better the content: inside one workbook is usually 10 sheets. 8x of them are the same (gas chambers from 1-8) and depending on the customer wishes, they can populated from 1-8. Sometimes 1 sometimes 5.
And range is from A1:Q54, full of data, tables, calculations, dropdowns, infos..
One sheet (9th) is customer details and last one (10th) is just instruction sheet with infos and screenshots.
So optimal would be to have macro that is taking everything from older versions, compare it with new one, and populate data that it finds, or on already given workbook or on new one but with the same content. I dont know if that is something possible.
An example of how to scan various cell ranges in a workbook and collate those that have values into a table. Second stage would be to transfer those values to the new format template.
Option Explicit
Sub extractAll()
Dim myfile As String, wb As Workbook, ws As Worksheet
Dim n As Long, rng1 As Range, rng2 As Range, msg As String
' select workbook to scan
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Please select a file"
.Show
.AllowMultiSelect = False
If .SelectedItems.Count = 0 Then 'If no folder is selected, abort
MsgBox "You did not select a file"
Exit Sub
End If
myfile = .SelectedItems(1)
End With
' collate data on sheet 1 and 2
Sheet1.Cells.Clear
Sheet1.Range("A1:E1") = Array("Sheet", "Addr", "Row", "Column", "Value")
Set rng1 = Sheet1.Range("A2")
Sheet2.Cells.Clear
Sheet2.Range("A1:D1") = Array("Addr", "Row", "Column", "Value")
Set rng2 = Sheet2.Range("A2")
' open workbook and scan worksheets
Set wb = Workbooks.Open(myfile, ReadOnly:=True)
For Each ws In wb.Sheets
If ws.Name Like "CH_recipe_#" Then
Call scanSheet(ws, rng1)
msg = msg & vbLf & ws.Name
ElseIf ws.Name = "Customer Details" Then
Call scanCustomer(ws, rng2)
msg = msg & vbLf & ws.Name
End If
Next
wb.Close savechanges:=False
MsgBox "Sheets scanned" & msg
End Sub
Sub scanSheet(ws As Worksheet, ByRef rng As Range)
Dim cell As Range, ar, s As String
Dim i As Long, n As Long
' old template layout
s = "D13,A15,C15,D15,E15,G15,J15,N15," ' process details
s = s & "E20:P24,E41:P41," ' Carrier, Gas 2-12, usage
s = s & "C45,D45,E45,G45,I45,K45,M45,N45,P45," ' exhaust line
s = s & "C48" ' notes and remarks
ar = Split(s, ",")
For i = 0 To UBound(ar)
For Each cell In ws.Range(ar(i))
If cell.Value <> "" Then
rng = ws.Name
rng.Offset(, 1) = cell.Address(0, 0)
rng.Offset(, 2) = cell.Row
rng.Offset(, 3) = cell.Column
rng.Offset(, 4) = cell.Value
Set rng = rng.Offset(1)
End If
Next
Next
Debug.Print ws.Name & " Done"
End Sub
Sub scanCustomer(ws As Worksheet, ByRef rng As Range)
Dim cell As Range, ar, s As String
Dim i As Long, n As Long
' old template layout
s = "B14:B25," ' contact details
s = s & "B28:B29," ' existing install
s = s & "B32:B35," ' hook up
s = s & "A38" ' remarks
ar = Split(s, ",")
For i = 0 To UBound(ar)
For Each cell In ws.Range(ar(i))
If cell.Value <> "" Then
rng = cell.Address(0, 0)
rng.Offset(, 1) = cell.Row
rng.Offset(, 2) = cell.Column
rng.Offset(, 3) = cell.Value
Set rng = rng.Offset(1)
End If
Next
Next
Debug.Print ws.Name & " Done"
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:
I would like to find the cells (or Rows) in Column B, Sheet1, who have matching values placed into ListBox2. Then, I'd like to change the value of a cell 4 columns over (using an Offset command).
I believe using a For loop is the most efficient way of going thru the values placed into ListBox2. I tried using a Forloop to go thru all values placed into ListBox2.List. Upon calling a value, the code would look for this value in Column B. Once found, it would "remember" the Row in which this value was found. Then, the code would use a Range/Offset command to change the value of a cell 4 columns over in that Row.
Private Sub ButtonOK_Click()
Dim wb As Workbook
Dim ws As Worksheet
Dim SerialList As Range
Dim SerialRow As Long
Dim i As Long
Set wb = ActiveWorkbook
Set ws = ActiveWorkbook.Worksheets("Sheet1")
Dim strFind As Variant
With ws
For i = 0 To Me.ListBox2.ListCount - 1
Set SerialList = ws.Range("B:B").Find(What:=Me.ListBox2.List(i))
SerialRow = SerialList.Row
If Not SerialList Is Nothing Then
ws.Range("B", SerialRow).Offset(0, 4).Value = Me.ListBox2.List(i) 'error occurs here!
MsgBox (ListBox2.List(i) & " found in row: " & SerialList.Row)
Else
MsgBox (ListBox2.List(i) & " not found")
End If
Next i
End With
End Sub
The MsgBoxes do say the correct ListBox2.List(i) value and the correct SerialList.Row, meaning that the program is correctly finding the row in which the list box value is located. However, I get an error saying that my range is not correctly defined at line "ws.Range("B", SerialRow)....."
How do I select the cell I'm searching for to correctly set it to =Me.ListBox2.List(i)?
Couple of fixes:
Dim lv
'....
For i = 0 To Me.ListBox2.ListCount - 1
lv = Me.ListBox2.List(i)
Set SerialList = ws.Range("B:B").Find(What:=lv, LookAt:=xlWhole) '<< be more explicit
'don't try to access SerialList.Row before checking you found a match...
If Not SerialList Is Nothing Then
ws.Cells(SerialList.Row, "F").Value = lv '<< Cells in place of Range
MsgBox (lv & " found in row: " & SerialList.Row)
Else
MsgBox (lv & " not found")
End If
Next i
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)
I want to enter multiple values in a single cell in excel sheet based on the certain condition as in if there are multiple sheets in the workbook then if any of the sheet starting with name TC contains color in it then I've to enter the information in Read Me Section of the Excel Workbook a another worksheet. The problem with my code is that its not displaying unique sheets which contain coloring...Suppose Sheet "TC_1" and "TC_3" contains color in any of the cell then its displaying the output as ";TC_3;TC_3;TC_3;" although the expected output over here is "TC_1;TC_3".
Here, is the code:
Sub ErrorInSheet()
Dim Row
Dim Names As String
Names = ""
For Row = 2 To tsheet.UsedRange.Rows.Count
For Chkcol = 1 To tsheet.UsedRange.Columns.Count
If tsheet.Cells(Row, Chkcol).Interior.ColorIndex = 3 Then
Names = Names & ";" & tsheet.Name
End If
Next
Next Row
Sheets("Read Me").Cells(13, 5).Value = Names
End Sub
Sub iterateSheets()
For Each sheet1t In Worksheets
If InStr(1, sheet1t.Name, "TC") Then
Set tsheet = sheet1t
Call ErrorInSheet
End If
Next
End Sub
I think this will work for you - I tested it and worked for me.
Sub FindErrors()
Dim sht As Worksheet, cl As Range, shtNames As String
shtNames = vbNullString
For Each sht In Worksheets
If Left$(sht.Name, 2) = "TC" Then
For Each cl In sht.UsedRange.Cells
If cl.Interior.ColorIndex = 3 Then
shtNames = IIf(shtNames = vbNullString, sht.Name, shtNames & ";" & sht.Name)
End If
Next cl
End If
Next sht
Worksheets("Read Me").Cells(13, 5) = shtNames
End Sub
Notes:
I've explicitly declared the variables
I am assuming all your sheets start with "TC" so I've used Left$ but you can use InStr if you like
I've used the ternary IIF statement to stop you getting a leading ;
I've put all the code in one Sub but you can split it out if you like