Hi all!
I have been trying to make vba code for the following purpose: copy a range of a workbook (screenshot above A1:F2) to a new workbook.
I have managed to achieve this. There is one additional criteria which i would like to add to the vba code. The vba code should only copy those columns where row 2 has a value filled in.
Thus, looking at the example in the screenshot, this would mean that by running the vba code, I would save to a new workbook the ranges A1:A2, C1:C2, E1:E2.
The new worbook would look like the second screenshot
Any help appreciated! Thanks in advance!
A very useful way of ignoring blanks - without looping - is to use SpecialCells. The code below is probably a little lengthier than needed for your question but it is written so that
It can be adapted to other sheets
It will copy non-blanks from row 2 whether they are values and/or formulae
In absence of seeing your code it copies to a new workbook
code
Sub CopyEm()
Dim WB As Workbook
Dim ws As Worksheet
Dim rng1 As Range
Dim rng2 As Range
Dim rng3 As Range
Set ws = Sheets(1)
On Error Resume Next
Set rng1 = ws.Rows(2).SpecialCells(xlConstants)
Set rng2 = ws.Rows(2).SpecialCells(xlFormulas)
If rng1 Is Nothing Then
Set rng3 = rng2
ElseIf rng2 Is Nothing Then
Set rng3 = rng1
Else
Set rng3 = Union(rng1, rng2)
End If
If rng3 Is Nothing Then Exit Sub
On Error GoTo 0
Set WB = Workbooks.Add
rng3.Offset(-1, 0).Copy WB.Sheets(1).[a1]
rng3.Copy WB.Sheets(1).[a2]
End Sub
Related
I have a workbook contain about 50 worksheets (sheet 1, sheet 2, sheet 3,........, sheet 50).
I want to get the data in all of them into one sheet. I used following code for that.
Sub tgr()
Dim ws As Worksheet
Dim wsDest As Worksheet
Set wsDest = Sheets("Sheet1")
For Each ws In ActiveWorkbook.Sheets
If ws.Name <> wsDest.Name Then
'ws.Range("A2", ws.Range("A22:Y500").End(xlToRight).End(xlDown)).Copy
ws.Range("A12:Y60").Copy
wsDest.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
End If
'ActiveWorkbook.Save
Next ws
End Sub
But this code isn't working for all the sheets i have. it applies to random sheets.
What should i do to make it apply for all the sheets. (I have different rows in each sheet.)
And also above code runs for a long time.
The following code will consolidate data from all sheets in the workbook that is running the code.
Note that this is pasting just values (not formmating or formulas)
EDIT: Just for making this answer more clear. Using full qualifying of the target workbook and preventing to work with the active workbook, will guarantee that your looping through all the sheets. I address OPs request of looping through all sheets and not random ones. And also add a way to speed up the process.
Read the comments and adjust it to fit your needs:
Public Sub ConsolidateData()
' Declare and initialize the destination sheet
Dim destinationSheet As Worksheet
Set destinationSheet = ThisWorkbook.Worksheets("Sheet1")
' Loop through all worksheets in the workbook that is running the script
Dim sourceSheet As Worksheet
For Each sourceSheet In ThisWorkbook.Worksheets
If sourceSheet.Name <> destinationSheet.Name Then
' Set the source sheet's range
Dim sourceRange As Range
Set sourceRange = sourceSheet.UsedRange ' I'm using used range, but you could leave it as you had it in terms of a fixed range: sourceSheet.Range("A12:Y60").Copy
' Get first available cell in column A (from bottom to top)
Dim targetCell As Range
Set targetCell = destinationSheet.Range("A" & destinationSheet.Cells(destinationSheet.Rows.Count, "A").End(xlUp).Row).Offset(1, 0)
' Resize and assign values from source range (using value2 speeeds up things)
targetCell.Resize(sourceRange.Rows.Count, sourceRange.Columns.Count).Value2 = sourceRange.Value2
End If
Next sourceSheet
End Sub
I have a bunch of .csv data reports i need to clean up in Excel.
I have been trying to write a macro that would select everything, then deselect a few specific rows and columns from the selection.
I don't need the code to go any further than that as i have another macro that works for deleting everything.
The nice thing is that the data im removing is consistent so i can hard code what needs to go bye bye.
Ive got some C# exposure but not VBA and particularly to MS Excel. I found some code I have been trying to adapt but am not getting it to do anything or just error out. At this point I was thinking to get it to do one line, then figure out how to remove the others.
Can I get some pointers on how to Select everything minus A row or column?
Sub Macro1()
'
' Macro1 Macro
' report format
'
Dim rng As Range
Dim InputRng As Range
Dim DeleteRng As Range
Dim OutRng As Range
' xTitleId = "KutoolsforExcel"
Set InputRng = Application.Selection
' Set InputRng = Application.InputBox("Range :", xTitleId, InputRng.Address, Type:=8)
Set DeleteRng = Application.Rows(7)
For Each rng In InputRng
If Application.Intersect(rng, DeleteRng) Is Nothing Then
If OutRng Is Nothing Then
Set OutRng = rng
Else
Set OutRng = Application.Union(OutRng, rng)
End If
End If
Next
OutRng.Select
'
End Sub
So i feel silly as I completely overlooked that Excel can attempt to auto record macros. I gave it a whirl and it did what I needed to do.
here is the auto generated code to produce the end result I needed. It only highlights the desired cells. From there I can use keyboard shortcuts to format the sheet.
I absolutely don't understand what it did but here it is.
Sub work()
'
' work Macro
'
'
Range("M3:XFD1048576,F3:J1048576,C3:C1048576").Select
Range("C3").Activate
End Sub
Sub Macro()
Dim wb As Workbook
Set wb = ThisWorkbook
'Consider column(2) as B column
wb.Worksheets("Sheet1").Columns(2).EntireColumn.Delete
I have a workbook, with multiple sheets, which have comments. I have to loop through each of the sheets and pick up the comments. I have implemented the following logic.
For Each Ip_Sheet In ActiveWorkbook.Worksheets
Set Rng = Ip_Sheet.Cells.SpecialCells(xlCellTypeComments)
If Rng Is Nothing Then
MsgBox "No comments in the sheet"
Else
For Each cell In Rng
Comment_Author_NameAndComment = Split(cell.Comment.Text, ":")
AuthName = Comment_Author_NameAndComment(0)
AuthComments = Comment_Author_NameAndComment(1)
The above logic works fine if there are no merged cells in the worksheet. However, if there are merged cells/rows, the loop For Each cell In Rng runs for each of the cells in the merged cells range. For example, if columns A:D are merged, then the loop runs for each of the cells A, B, C and D and I get the same value in the AuthName and AuthComments variables.
My question is, how do I make the loop to skip to the next comment on the worksheet if I find a merged cell?
Edit:
I also tried to loop through all the comments in the sheet by the following method, however, the method was not successful - the Rng.Comment object was always empty.
For Each cmnt_obj In Rng.Comment
cmt_txt = cmnt_obj.Text
Next cmnt_obj
Since SpecialCells(xlCellTypeComments) returns all cells for a Merged Range, you need to detect when a cell is part of a named range and only process one of those cells. You can use Range.MergeCells to detect a merged cell, and Range.MergeArea to return the merged range itself. Then only report the comment if the cell is the Top Left cell of the merged range.
Something like this:
Sub Demo()
Dim rng As Range
Dim cl As Range
Dim wb As Workbook
Dim ws As Worksheet
Set wb = ActiveWorkbook
For Each ws In wb.Worksheets
Set rng = ws.Cells.SpecialCells(xlCellTypeComments)
If Not rng Is Nothing Then
For Each cl In rng.Cells
If cl.MergeCells Then
If cl.Address = cl.MergeArea.Cells(1).Address Then
ReportComment cl
End If
Else
ReportComment cl
End If
Next
End If
Next
End Sub
Sub ReportComment(cl As Range)
Dim Comment_Author_NameAndComment() As String
Dim AuthName As String
Dim AuthComments As String
Comment_Author_NameAndComment = Split(cl.Comment.Text, ":")
AuthName = Comment_Author_NameAndComment(0)
AuthComments = Comment_Author_NameAndComment(1)
Debug.Print AuthName, AuthComments
'...
End Sub
I am trying to expand upon a worksheet and require assistance.
Currently I have the following macro set up to copy from one sheet range and paste to another sheet:
Private Sub CommandButton1_Click()
Dim Rng1 As Range
Dim Rng2 As Range
Set Rng1 = Range("D12:G253")
Set Rng2 = Range("D12:G253")
Rng2.Value = Rng1.Value
Dim xlws1 As Worksheet
Dim xlws2 As Worksheet
Set xlws1 = Worksheets("Data")
Set Rng1 = xlws1.Range("d12:g253")
Set xlws2 = Worksheets("Final")
Set Rng2 = xlws2.Range("D12:g253")
Rng2.Value = Rng1.Value
However, now I would like the data pasted to be dynamic and not always land in "D12:G253" but instead find the four columns that correspond to the value in either the seventh or eight row. I have descriptions set up in the first three columns that I will stay and not need to be copied and I have headers in the first 11 rows that will not need to change either.
I've tried following these posts Post 1 Post 2 but cannot follow completely due to my lack of coding knowledge.
Please help me so I can expand.
I am having a lot of trouble with this one. I want to replicate this value in VBA:
=MAX(MAX(Named_Range1),MAX(Named_Range2),MAX(Named_Range3))
I am having an impossible time trying to get this done.
If the three ranges are in the same sheet then:
Sub MaxMax()
Dim r As Range
Set r = Union(Range(Named_Range1), Range(Named_Range2), Range(Named_Range3))
MsgBox Application.WorksheetFunction.Max(r)
End Sub
If you don't want to place the formula in one of the cells and calculate the result in VBA code, you can also use the following code:
Dim rng1 As Range, rng2 As Range, rng3 As Range
Dim y As Double
Set rng1 = ThisWorkbook.Names("Named_Range1").RefersToRange
Set rng2 = ThisWorkbook.Names("Named_Range2").RefersToRange
Set rng3 = ThisWorkbook.Names("Named_Range3").RefersToRange
y = WorksheetFunction.Max(rng1, rng2, rng3)
If named ranges are in another workbook, replace ThisWorkbook with Workbooks("workbook name")
For the result to be placed in F9, please try:
Sub Maximal()
Range("F9").Formula = "=MAX(MAX(Named_Range1),MAX(Named_Range2),MAX(Named_Range3))"
End Sub