i have an Workbook with 5 Sheets where you can add Data while Using a Userform. The Data begins in each Sheet in row 10, since i nead the rows above 10 for my interface. I have also an Mastersheet, where the Data from these specific Sheets should be copied and should be edited if needed by DoubleClick and an Unserform. I Managed to write the Code for Copying the Data from these Sheets, but I also need the Sheetname next to the Data in Column A, so it's clear where the Data is from. The Data begins also in Row 10 of the Mastersheet.
1.Problem: Can't get the Sheet names in Column A and the Data to start in Column A.
2. If one Sheet is empty it Copies the Headers into the Mastersheet
3. By Double Click in the Row my Userform doesn't appear.
When i write The Sheet Name in Column B of the Mastersheet, the Data gets edited. But The Mastersheet should refresh itself when the editing is done
I would really appreciate if someone could help me, since i just startet with vba and don't know What to do.
`
Private Sub Worksheet_Activate()
Dim Ws As Worksheet
Me.Rows("6:" & Rows.count).Clear
Me.Range("A9:Z9").Value = Array("Markt".... (And So on)
For Each Ws In ThisWorkbook.Worksheets
If Ws.Name <> "Summary" And Ws.Name <> "Startseite" And Ws.Name <> "Agenda" (And so on) Then
Ws.Rows("10:" & Ws.Cells.Find("*", searchdirection:=xlPrevious).Row).Copy Me.Range("A" & Me.Cells.Find("*", searchdirection:=xlPrevious).Row + 1)
End If
Next Ws
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)
Dim Sheet As String
Dim POS As Integer
Cancel = True
If Range(Target.Address).Row >= 10 Then
Sheet = Cells(Target.Row, 2).Value 'Get The Sheet Name from Column B I could change that bu I need the Sheet name in a Column to do that
If IsNumeric(Cells(Target.Row, 1).Value) Then
POS = CInt(Cells(Target.Row, 1).Value)
Else
POS = 0
End If
Else
Exit Sub
End If
If POS = 0 Then
Exit Sub
Else
Sheets("Code").Range("G2") = Sheet
Sheets("Code").Range("G3") = POS
End If
Edit.Show
End Sub
`
I tried changing the code but it didn't work
Related
I am currently working on deleting rows. I have already made it work in one sheet, but I just want to ask if there is any way to delete rows in several sheets at the same time? I have a unique key which is the student ID that is in Column C of all the sheets that will be affected. So, by clicking on the delete button, all data with this student ID will be deleted.
Using the code below, I can delete a row from the STUDENTS_INFO sheet.
Sub del_stud()
Set ws = ActiveWorkbook.Worksheets("STUDENTS_INFO")
LastRow = ws.Cells(Rows.Count, "C").End(xlUp).Row
For r = 10 To LastRow
If CStr(ThisWorkbook.Sheets("HOME").Range("K11").Value) = ws.Cells(r, 3) Then
ws.Rows(r).EntireRow.Delete
MsgBox "Student's data is now deleted!"
Unload Me
End If
Next r
End Sub
The sheets that will be affected are STUDENTS_INFO, G1-Q1, G1-Q2, G1-Q3, G1-Q4, G2-Q1, G2-Q2, G3-Q3, G4-Q4, and so on... I also have sheets that, hopefully, will not be touched. Is this possible?
Based on my research, it uses the For Each ws In ThisWorkbook.Sheets. I tried to use it, but it still deletes the row in STUDENTS_INFO sheet and not on multiple sheets.
Here's the code that I tried.
Application.ScreenUpdating = False
For Each ws In ThisWorkbook.Sheets
LastRow = ws.Cells(Rows.Count, "C").End(xlUp).Row
For r = 10 To LastRow
If CStr(ThisWorkbook.Sheets("HOME").Range("K11").Value) = ws.Cells(r, 3) Then
ws.Rows(r).EntireRow.Delete
MsgBox "Student's data is now deleted!"
Unload Me
End If
Next r
Next ws
Application.ScreenUpdating = True
I’d agree with #urdearboy’s suggestion of using a filter to delete the rows – plus looping through an array of sheets that you designate. The following code assumes the Student ID is sourced from the cell K11 on the HOME sheet. You can add/remove sheets from the array as you see fit.
Try the following & let me know how you go.
Option Explicit
Sub del_stud()
Dim StudID As String, ws As Worksheet
'Get the filter criteria from cell K11 in the HOME sheet
StudID = ThisWorkbook.Sheets("HOME").Range("K11").Value
'Do the STUDENTS_INFO sheet by itself
With ThisWorkbook.Sheets("STUDENTS_INFO").Cells(8, 3).CurrentRegion
.AutoFilter 1, StudID
.Offset(1).EntireRow.Delete
.AutoFilter
End With
'Do the other generic sheets next - add/remove sheets as required
For Each ws In Sheets(Array("G1-Q1", "G1-Q2"))
With ws.Cells(9, 3).CurrentRegion
.AutoFilter 1, StudID
.Offset(1).EntireRow.Delete
ws.AutoFilterMode = False
End With
Next ws
End Sub
I have created the following Excel-spreadsheet:
A B C D E
1 Sheet1
2 Sheet2
3 Sheet5
4 Sheet6
5 Sheet8
6 Sheet9
7
As you can see, in Column A I have listed some of the sheets within the Excel file.
Now, I use the below VBA to get this list into a ComboBox:
Sub UserForm_Activate()
ComboBox1.List = Sheet1.Range("A1:A8").Value
End Sub
All this works fine so far.
However, now it can happen that some of the sheets are not visible. Therefore, I also do not want them to appear in the ComboBox.
One solution I found was the answer from here. However, this VBA only works over the entire Excel file but as you can see in my list above some sheets (Sheet3, Sheet4, Sheet7) are excluded from the list. Those sheets should also remain excluded no matter if they are visible or not.
So for example, when I make Sheet2 and Sheet6 invisible the list in the ComboBox should automatically be adjusted and look like this:
Sheet1
Sheet5
Sheet8
Sheet9
What do I need to change in my VBA to achieve this?
The code below puts the sheets from the worksheet into a dynamic array and checks if it's visible, so you're not hard-coding the visible sheets. Therefore, excluding the sheets you don't want (Sheet3, Sheet4 and Sheet7) from the worksheet will also exclude them from your ComboBox.
Private Sub UserForm_Activate()
Dim sheet_list As Variant
sheet_list = Sheet1.Range("A1:A8").Value
'get the list of Sheets from Column A
Dim combo_list As Variant
combo_list = Array()
'create and empty array
Dim sheet_name As Variant
For Each sheet_name In sheet_list
'loop through sheets
If ThisWorkbook.Worksheets(sheet_name).Visible Then
'check if they are visible
Dim ub As Long
ub = UBound(combo_list) + 1
ReDim Preserve combo_list(ub)
'increment array dimension
combo_list(ub) = sheet_name
'add Sheet to array
End If
Next sheet_name
ComboBox1.List = combo_list
'populate the ComboBox
End Sub
Based on linked topic I modified the code from answer to reach what You want to achieve
Private Sub ChangeComboBox()
Dim xSheet As Worksheet
' Clear the combobox
ComboBox1.Clear
' Add the sheets again
For Each xSheet In ThisWorkbook.Sheets
'~~> Check if they are visible
If xSheet.Visible = xlSheetVisible Then
If xSheet.Name <> Sheet3.Name And xSheet.Name <> Sheet4.Name And xSheet.Name <> Sheet7.Name Then
ComboBox1.AddItem xSheet.Name
End If
End If
Next
End Sub
To all,
thanks for your time in advance.
we already have working code to move data from one wrksht to another with vb in excel.
we use:
Set lastrow = Sheets ("SR log").Cells(Rows.Count, 1).End(x1UP)
With LastRow
This places our selected data on the last open row of sheet 2
Is it possible to , instead of the last row, Search for a reference number from the first sheet that is already on the second sheet , lets say Cell G3. use the information from the first sheet in cell g3 and look for it on the second sheet.
Once that row is found ( the G3 data from the first sheet will be in column A of the second sheet)
Now apply data to that row where applicable.
any help would be appreciated.
2/22/19
Here is my response.
thankyou for taking the time
I have put something together but wanted to run it by before executing
[code]
Private Sub CommandButton2_Click()
Workbooks.Open Filename:="G:\General\COVER SHEET_Protective\Protective Packaging Order Log.xlsm", Password:="PP", WriteResPassword:="PP"
Dim FoundRow As Variant
FoundRow = Application.Match(Sheets(1).Range("G3"), Sheets(2).Columns(1), 0)
If IsNumeric(FoundRow) Then
With FoundRow
' found, use FoundRow like LastRow before
End With
Else
' not found :(
End If
.Offset(1).Font.Size = 14
.Offset(1, 9) = ws.[I10]
.Offset(1, 10) = ws.[I11]
End Sub
[/code]
I'm am a little unsure about this row
[code]
Application.Match(Sheets(1).Range("G3"), Sheets(2).Columns(1), 0)
[/code]
the match sheets 1 on the first workbook is called worksheet
and on the second workbook where the search is happening on the first
column
the sheet is called orderlog
thanks
You can find the matching row with Application.Match:
Private Sub CommandButton2_Click()
Dim wb1 As Workbook ' first workbook
Dim wb2 As Workbook ' second workbook
Dim wsCheck As Worksheet ' sheet in the first workbook
Dim wsOrderlog As Worksheet ' sheet in the second workbook
' address the first workbook and its sheet
' if this VBA-code is in the frist workbook, it's "ThisWorkbook"
Set wb1 = ThisWorkbook
Set wsCheck = wb1.Worksheets("Worksheet")
' check, if second workbook is already open
For Each wb2 In Workbooks
If wb2.Name = "Protective Packaging Order Log.xlsm" Then Exit For
Next wb2
' if not already open, then open it, and address its sheet also
If wb2 Is Nothing Then
Set wb2 = Workbooks.Open( _
Filename:="G:\General\COVERSHEET_Protective\Protective Packaging Order Log.xlsm", _
Password:="PP", _
WriteResPassword:="PP")
End If
Set wsOrderlog = wb2.Worksheets("orderlog")
' search a value from the first workbook's sheet within second workbook's sheet
Dim FoundRow As Variant
FoundRow = Application.Match(wsCheck.Range("G3").Value, wsOrderlog.Range("A:A"), 0)
If IsNumeric(FoundRow) Then ' if found
' please adapt to your needs:
wsOrderlog.Cells(FoundRow, 1).Font.Size = 14
wsOrderlog.Cells(FoundRow, 9).Value = wsCheck.Range("I10").Value
wsOrderlog.Cells(FoundRow, 10).Value = wsCheck.Range("I11").Value
Else
MsgBox "Sorry, the value in cell G3" & vbLf & _
wsCheck.Range("G3").Value & vbLf & _
"could not be found in orderlog column A."
End If
' close the second workbook (Excel will ask, if to save)
wb2.Close
End Sub
Unfortunately for my employer, none of my network engineering courses included advanced Excel formula programming. Needless to say, I know nothing about Excel save for basic SUM and COUNT formula commands.
My employer has an Excel workbook with multiple worksheets within it representing each month of the calendar year. We want to be able to have a "total" worksheet in the workbook that reflects all data across the entire workbook in each column/row.
An example for the sake of clarity:
In the worksheet "May_2013", column A is labeled "DATE". Cell A2 contains the data "MAY-1".
In the worksheet "June_2013", column A is labeled "DATE". Cell A2 contains the data "JUNE-1".
In the worksheet "Total", column A is labeled "DATE". We want cells A2 to reflect "MAY-1" and A3 to reflect "JUNE-1".
We want to do this for all worksheets, columns A-Q, rows 2-33 and populate a master sheet at the very end containing all data in all worksheets in their corresponding columns.
Is this possible?
Here are two VBA solutions. The first does this:
Check if a sheet "totals" exists. Create it if it does not
Copy the first row (A to Q) of first sheet to "totals"
Copy block A2:Q33 to "totals" sheet starting at row 2
Repeat for all other sheets, appending 32 rows lower each time
The second shows how to do some manipulation of the column data before copying: for each column it applies the WorksheetFunction.Sum(), but you could replace that with any other aggregating function that you would like to use. It then copies the result (one row per sheet) to the "totals" sheet.
Both solutions are in the workbook you can download from this site. Run the macros with , and pick the appropriate one from the list of options that shows up. You can edit the code by invoking the VBA editor with .
Sub aggregateRaw()
Dim thisSheet, newSheet As Worksheet
Dim sheetCount As Integer
Dim targetRange As Range
sheetCount = ActiveWorkbook.Sheets.Count
' add a new sheet at the end:
If Not worksheetExists("totals") Then
Set newSheet = ActiveWorkbook.Sheets.Add(after:=Sheets(sheetCount))
newSheet.Name = "totals"
Else
Set newSheet = ActiveWorkbook.Sheets("totals")
End If
Set targetRange = newSheet.[A1]
' if you want to clear the sheet before copying data, uncomment this line:
' newSheet.UsedRange.Delete
' assuming you want to copy the headers, and that they are the same
' on all sheets, you can copy them to the "totals" sheet like this:
ActiveWorkbook.Sheets(1).Range("1:1").Copy targetRange
Set targetRange = targetRange.Offset(1, 0) ' down a row
' copy blocks of data from A2 to Q33 into the "totals" sheet
For Each ws In ActiveWorkbook.Worksheets
If ws.Name <> newSheet.Name Then
ws.Range("A2", "Q33").Copy targetRange
Set targetRange = targetRange.Offset(32, 0) ' down 32 rows
End If
Next ws
End Sub
Sub aggregateTotal()
Dim thisSheet, newSheet As Worksheet
Dim sheetCount As Integer
Dim targetRange As Range
Dim columnToSum As Range
sheetCount = ActiveWorkbook.Sheets.Count
' add a new sheet at the end:
If Not worksheetExists("totals") Then
Set newSheet = ActiveWorkbook.Sheets.Add(after:=Sheets(sheetCount))
newSheet.Name = "totals"
Else
Set newSheet = Sheets("totals")
End If
' assuming you want to copy the headers, and that they are the same
' on all sheets, you can copy them to the "totals" sheet like this:
Set targetRange = newSheet.[A1]
ActiveWorkbook.Sheets(1).Range("A1:Q1").Copy targetRange
Set targetRange = targetRange.Offset(1, 0) ' down a row
For Each ws In ActiveWorkbook.Worksheets
' don't copy data from "total" sheet to "total" sheet...
If ws.Name <> newSheet.Name Then
' copy the month label
ws.[A2].Copy targetRange
' get the sum of the coluns:
Set columnToSum = ws.[B2:B33]
For colNum = 2 To 17 ' B to Q
targetRange.Offset(0, colNum - 1).Value = WorksheetFunction.Sum(columnToSum.Offset(0, colNum - 2))
Next colNum
Set targetRange = targetRange.Offset(1, 0) ' next row in output
End If
Next ws
End Sub
Function worksheetExists(wsName)
' adapted from http://www.mrexcel.com/forum/excel-questions/3228-visual-basic-applications-check-if-worksheet-exists.html
worksheetExists = False
On Error Resume Next
worksheetExists = (Sheets(wsName).Name <> "")
On Error GoTo 0
End Function
Final(?) edit:
If you want this script to run automatically every time someone makes a change to the workbook, you can capture the SheetChange event by adding code to the workbook. You do this as follows:
open the Visual Basic editor ()
In the project explorer (left hand side of the screen), expand the VBAProject
Right-click on "ThisWorkbook", and select "View Code"
In the window that opens, copy/paste the following lines of code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
' handle errors gracefully:
On Error GoTo errorHandler
' turn off screen updating - no annoying "flashing"
Application.ScreenUpdating = False
' don't respond to events while we are updating:
Application.EnableEvents = False
' run the same sub as before:
aggregateRaw
' turn screen updating on again:
Application.ScreenUpdating = True
' turn event handling on again:
Application.EnableEvents = True
Exit Sub ' if we encountered no errors, we are now done.
errorHandler:
Application.EnableEvents = True
Application.ScreenUpdating = True
' you could add other code here... for example by uncommenting the next two lines
' MsgBox "Something is wrong ... " & Err.Description
' Err.Clear
End Sub
Kindly use RDBMerge add-in which will combine the data from different worksheet and create a master sheet for you. Please see the below link for more details.
http://duggisjobstechnicalstuff.blogspot.in/2013/03/how-to-merge-all-excel-worksheets-with.html
Download RDBMerge
You can use the indirect function to reference the sheet name. In the image below this function takes the header name (B37) and uses it as the sheet reference. All you have to do is choose the correct "total cell" which I made "A1" in "MAY_2013". I put an image below to show you my reference name as well as tab name
https://www.dropbox.com/s/f83y17dedajbsz8/example.xls
That's a quick sample workbook of what I want this to work in.
Right now, sheet 1 (main) needs to have data from all the other worksheets copied to it manually. At the moment, what I am doing is I have a list of the unique codes I need, and I go to the sheet and ctrl+F for that code, then manually copy+paste that row into sheet 1 (main). It can be a bit time consuming.
What I want to do instead is to simply TYPE ANY unique code into any cell of column D on sheet 1, and then if that code matches the code on any of the other sheets, then the entire row will copy over to sheet 1.
Is this easily do-able?
The following VBA should do the trick, you need to copy it into the workbook code section for Sheet1 (Main).
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Sheet As Worksheet
Dim Index As Integer
Dim Count As Integer
Dim Match As Range
If Target.Rows.Count > 1 Or Target.Columns.Count > 1 Then
' You've done something that has edited lots of cells. Cant handle this.
Exit Sub
End If
Set Sheet = ThisWorkbook.Worksheets("Main")
If Not Intersect(Sheet.Range("D:D"), Target) Is Nothing Then
' The edited cell falls in the range D:D
Count = ThisWorkbook.Worksheets.Count
For Index = 1 To Count
If Not ThisWorkbook.Worksheets(Index).Name = Sheet.Name Then
Set Match = ThisWorkbook.Worksheets(Index).Range("D:D").Find(What:=Target.Value, LookIn:=xlValues)
If Not Match Is Nothing Then
'copy the line across
ThisWorkbook.Worksheets(Index).Range("A" & Match.Row & ":E" & Match.Row).Copy Sheet.Range("A" & Target.Row)
Exit For
End If
End If
Next Index
End If
If Match Is Nothing Then
' optional, if the target string is not found clear the line.
Sheet.Range("A" & Target.Row & ":E" & Target.Row).ClearContents
End If
End Sub