I need to resize excel particular column in a particular sheet.But not able to do so
Sub resizeColumn(sourceWb As String, Sheet As String, column As String)
Dim wkbSource As Workbook
Dim sheetName As Worksheet
Dim columnname As String
Application.ScreenUpdating = False
Set wkbSource = Workbooks.Open(sourceWb)
Set sheetName = wkbSource.Sheets(Sheet).Activate
Worksheets("Column width").Range("A5").ColumnWidth = 16
wkbSource.Close SaveChanges:=True
wkbSource.Close
End Sub
I think the problem is that you are mixing the names and objects.
I assume from your code that you would like to call this with this manner:
Sub CallResizeColumn()
Call ResizeColumn("PathToYourWorkbook.xlsm", "SheetToResize", "A5")
End Sub
I have changed a bit your notation by adding a p at the beginning of your parameters (I think it is not a good practice to call them very similar to the keywords).
Please keep in mind that you need to use the full reference to your range ("workbook.worksheet.range").
(Note: when you turn off the SreenUpdating, be sure that you turning it back.)
Private Sub ResizeColumn(pSourceWb As String, pSheet As String, pColumn As String)
Dim wkbSource As Workbook
Dim shSheet As Worksheet
Dim rngColumn As Range
'Application.ScreenUpdating = False
Set wkbSource = Workbooks.Open(pSourceWb)
Set shSheet = wkbSource.Sheets(pSheet)
Set rngColumn = shSheet.Range(pColumn)
rngColumn.ColumnWidth = 16
'wkbSource.Close SaveChanges:=True
wkbSource.Close
End Sub
Related
I run a monthly report that generates 16 tabs (15 worksheets: "Report1" - "Report15"). I've created a sub to create/format a table, and organize the data on Sheet2("Report1").
Objective:
Because of the Table Style, I would now like to loop the macro through "Report1", "Report4", "Report7", "Report10", "Report13" Only.
(Once I figure this out, I'll create a Macro with another Table Style for the other worksheets.)
Issues:
Through 'Googling' I created the below Loop, but the "Set ws = Worksheets(Report1") ws.active is throwing it off.
-Do I need to remove the set ws = worksheets(Report1")?
-I had the ws.active, because the macro didn't seem to work without it.
Macro:
Option Explicit
Sub LoopThroughSpecificWorksheets()
'Turn Off Screen Updates
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim wb As Workbook: Set wb = ActiveWorkbook
Dim ws As Worksheet
Dim LstObj As ListObjects
Dim LastRow As Long
Dim Report, i
Report = Array("Report1", "Report4", "Report7", "Report10", "Report13")
For i = LBound(Report) To unbound(Report)
With ws(Report(i))
Set ws = Worksheets("Report1")
ws.Activate
'...Body of Maco
'Insert Table
'Remove Table Format
'Apply Tablestyle:
'Apply a filter to $ Share for all Brands (Largest to Smallest)
'Update $ - % Chg formula
'Update Units - % Chg Formula
'Change Header Names and Resize
End With
Next i
'Turn On Screen Updates
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Below is some VBA code that loops your array of worksheets:
Sub sLoopArray()
Dim ws As Worksheet
Dim aReport As Variant
Dim lngLoop1 As Long
aReport = Array("Report1", "Report2")
For lngLoop1 = LBound(aReport) To UBound(aReport)
Set ws = Worksheets(aReport(lngLoop1))
With ws
End With
Next lngLoop1
End Sub
I've changed the type of unbound to UBound, declared the loop counter as Long (you had it as a variant which can cause problems), and also renamed the array from Report to aReport (to avoid "collision" with any inbuilt VBA names.
Regards,
I'm trying to run the program so that it deletes an already existing sheet, create a new one so that I can fill it with results. I want to be able to do this every time I run the program so that I get a new sheet without the previous results.
Dim CustomerID As Integer
Dim SameID As Integer
Dim TotalSpent As Currency
Dim HighSpenders As Integer
Dim CustomerOrder As Integer
Dim DataCell As Range
Dim ReportCell As Range
Dim UserAmount As Variant
Dim UserAmount1 As Integer
Dim wsData As Worksheet
Dim wsReport As Worksheet
Set wsData = ActiveWorkbook.Sheets("Data")
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Sheets("Report").Delete
On Error GoTo -1
Application.DisplayAlerts = True
Do
UserAmount = InputBox("Enter an amount")
If Not IsNumeric(UserAmount) Then
MsgBox "Enter a numeric value"
Else
UserAmount1 = CInt(UserAmount)
End If
Loop While Not IsNumeric(UserAmount)
Set wsReport = ActiveWorkbook.Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Report"
Set DataCell = wsData.Range("A3")
Set ReportCell = wsReport.Range("A3")
Problem now is that it's not creating a new worksheet called Report with the results
Delete Sheet ft. On Error Goto 0
If this code is in the ActiveWorkbook, you should use
ThisWorkbook instead, or refer to it by its name e.g. Workbooks(CreateReport.xlsm).
Use the With statement for objects to make the code more readable and
avoid unnecessary reference errors:
The paremeter part of the After argument After:=Sheets(Sheets.Count) ' is, I would say, incorrect and should have been:
After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count).
Why does it then still work correctly? It's because when omitting ActiveWorkbook, the ActiveWorkbook is actually used ('understood', 'default'). You could have omitted all the ActiveWorkbook references you used and all the Sheets would still have (correctly) referred to the ActiveWorkbook's sheets.
Why incorrect? You have decided to change all the ActiveWorkbook instances to Workbooks("CreateReport.xlsm"). You will probably not add the reference in the After argument, which could give you undesired results because it's referring to the ActiveWorkbook, which could be another workbook (not CreateReport.xlsm).
The last part lead us to another benefit of using the With statement, namely if you want to change the reference of the workbook, you will have to change it only in the With statement (once) e.g.:
With Workbooks("CreateReport.xlsm")
VBA
does not support On Error Goto -1, Visual
Basic
does. If you would have used
On Error Goto 0,
the code would have produced Run-time error '424': Object required and would have highlighted the line Set wsReport = ... and you would have immediately known that this was the line that had to be changed.
You can use the same variable UserAmount (as Variant) instead of
UserAmount1. To prevent Run-time error '6': Overflow when entering
a value that exceeds the Integer limit e.g. 32768, you should use
Long instead of Integer:
UserAmount = CLng(UserAmount)
' or:
Dim UserAmount1 as Long
...
UserAmount1 = Clng(UserAmount)
if you'll stick with variable UserAmount1.
You cannot Add a new worksheet and rename it in one go (in the same
line). You have to use two lines:
With ActiveWorkbook
Set wsReport = .Sheets.Add(After:=.Sheets(.Sheets.Count))
End With
wsReport.Name = "Report"
It is good practice to create titles or shortly describe various
sections of the code. I've probably added too many.
The Code
Sub AddSheet()
Dim CustomerID As Integer
Dim SameID As Integer
Dim TotalSpent As Currency
Dim HighSpenders As Integer
Dim CustomerOrder As Integer
Dim DataCell As Range
Dim ReportCell As Range
Dim UserAmount As Variant
'Dim UserAmount1 As Long
Dim wsData As Worksheet
Dim wsReport As Worksheet
' If this code is in the ActiveWorkbook, use ThisWorkbook instead.
With ThisWorkbook
' Create a reference to Data Sheet.
Set wsData = .Sheets("Data")
' Delete (old) Report Sheet.
On Error Resume Next
Application.DisplayAlerts = False
.Sheets("Report").Delete
Application.DisplayAlerts = True
On Error GoTo 0 ' VBA doesn't support On Error Goto -1
' Input UserAmount.
Do
UserAmount = InputBox("Enter an amount")
If Not IsNumeric(UserAmount) Then
MsgBox "Enter a numeric value"
Else
' You can use the same variable.
' To prevent "Run-time error '6': Overflow" when entering a
' value that exceeds the integer limit e.g. 32768, you have
' to use Long.
UserAmount = CLng(UserAmount)
'UserAmount1 = CLng(UserAmount)
End If
Loop While Not IsNumeric(UserAmount)
' Create a reference to a newly added sheet.
Set wsReport = .Sheets.Add(After:=.Sheets(.Sheets.Count))
End With
' Rename the newly added sheet.
wsReport.Name = "Report"
' Create references to cells "A3" of both worksheets.
Set DataCell = wsData.Range("A3")
Set ReportCell = wsReport.Range("A3")
End Sub
You re not declaring or Setting wsData or wsReport. This will at least set wsReport to the newly created worksheet.
Dim CustomerID As Integer, SameCustomerID As Integer
Dim TotalSpent As Currency
Dim HighSpenders As Integer, CustomerOrder As Integer, UserAmount1 As Integer
Dim DataCell As Range, ReportCell As Range
Dim UserAmount As Variant
dim wsData as worksheet, wsReport as worksheet
application.displayalerts = false 'do NOT ask for confirmation
on error resume next 'if Reports doesn't exist, keep going
ActiveWorkbook.Sheets("Report").Delete
on error goto -1 'reset the error handler
application.displayalerts = true 'turn alerts back on
Do
UserAmount = InputBox("Enter an amount")
If Not IsNumeric(UserAmount) Then
MsgBox "Enter a numeric value"
Else
UserAmount1 = CInt(UserAmount)
End If
Loop While Not IsNumeric(UserAmount)
set wsReport = ActiveWorkbook.workSheets.Add(After:=Sheets(Sheets.Count))
with wsReport
.Name = "Report"
end with
Set ReportCell = wsReport.Range("A3")
'wsData is still not set to any worksheet
Set DataCell = wsData.Range("A3")
I have multiple workbooks with worksheet named 'SUMMARY-F'. I need to combine these worksheets into one workbook and I am using the below code:
Sub CopySheets1()
Dim wkb As Workbook
Dim sWksName As String
sWksName = "SUMMARY-F"
For Each wkb In Workbooks
If wkb.Name <> ThisWorkbook.Name Then
wkb.Worksheets(sWksName).Copy _
Before:=ThisWorkbook.Sheets(1)
End If
Next
Set wkb = Nothing
End Sub
The code worked perfectly about 4 times however now when I run it, I get a subscript out of range error 9. Any tips on how to fix this?
Thanks,
Lucinda
If you have a workbook that is open that doesn't contain a sheet called SUMMARY-F you'll get an out-of-range error because Excel can't find a sheet with the specified name. This error will also apply to hidden workbooks such as a PERSONAL.xlsm if you've used it to record macros.
You should include a check in your code to handle the case when an open workbook doesn't have a sheet called SUMMARY-F.
See this question that gives options on how to identify if a sheet exists, such as defining a function that could be called from your code first:
How to check whether certain sheets exist or not in Excel-VBA?
You'll just need to modify it to check a sheet in another workbook, something like:
Public Function CheckSheet(ByVal sWB As String, ByVal sSheetName As String) As Boolean
Dim oSheet As Excel.Worksheet
Dim bReturn As Boolean
For Each oSheet In Workbooks(sWB).Sheets
If oSheet.Name = sSheetName Then
bReturn = True
Exit For
End If
Next oSheet
CheckSheet = bReturn
End Function
Then you can add a check in your code:
Sub CopySheets1()
Dim wkb As Workbook
Dim sWksName As String
sWksName = "SUMMARY-F"
For Each wkb In Workbooks
If wkb.Name <> ThisWorkbook.Name Then
If CheckSheet(wkb.Name,sWksName)
wkb.Worksheets(sWksName).Copy Before:=ThisWorkbook.Sheets(1)
End If
End If
Next
Set wkb = Nothing
End Sub
I'm having trouble with renaming a worksheet in VBA.
I'm writing a Sub that needs to check if there is a worksheet in the workbook that has a specific name, and if there isn't then make a new sheet with this name.
I get the runtime error 1004 application defined or object defined error. I'm hoping anyone can help me. Here is my code:
Dim ws As Worksheet
Dim ArrayElement As Variant
Dim Current_Tabs(1 To 10) As String
NumberNewTab = 1
Tab_Name_Current_Game = Echt_team1 + "vs. " + Echt_team2
For Each ws In Worksheets 'For every worksheet in this workbook
Found = False
For Each ArrayElement In Current_Tabs array
If Tab_Name_Current_Game = ArrayElement Then
Worksheets(ws).Activate
Worksheets.Select
Found = True
End If
Next ArrayElement
If Found = False Then
Worksheets.Add
Sheets(1).Name = Tab_Name_Current_Game **'Here I get the error**
Current_Tabs(NumberNewTab) = Tab_Name_Current_Game
NumberNewTab = NumberNewTab + 1
End If Next ws
If I use Sheets(1).Name = "Test" then I don't run into errors. I don't get why this would be a problem for VBA. Hoping someone can help me. Thank you!
You never defined Tab_Name_Current_Game.
Add Dim Tab_Name_Current_Game as String to your declarations at the top. Then see what happens.
You can make it much easier:
Public Sub renameSheet()
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
Dim Tab_Name_Current_Game As String
Set wb = Excel.ActiveWorkbook
'The line below is copied from your code, but I don't like it.
'You should pass Echt_team1 and Echt_team2 as input parameters to this Sub.
Tab_Name_Current_Game = Echt_team1 + "vs. " + Echt_team2
On Error Resume Next
Set ws = wb.Worksheets(Tab_Name_Current_Game)
On Error GoTo 0
If ws Is Nothing Then
Set ws = wb.Worksheets.Add
ws.Name = Tab_Name_Current_Game
End If
End Sub
To make the code more reliable, you can also add this function to your code: Function to check if sheet name is valid, and change this line:
ws.Name = Tab_Name_Current_Game
to
ws.Name = legalSheetName(Tab_Name_Current_Game)
It will ensure that the name you are trying to assign to a worksheet is not too long and has no illegal characters.
So I'm using this macro to extract only the data that I need to perform a regression, and the sample set includes quite a bit of useless information for my needs. When I try to select the columns from the CCDetail workbook- I get the "'Range' of object '_Global' Failed" error. Any ideas on why this is?
Sub ExtractCCDetail()
Dim WorkbookName As String
Dim CCDetail As Workbook
Dim Harvester As Workbook
Dim RAWData As Worksheet
Set CCDetail = Workbooks(2)
Set Harvester = ThisWorkbook
WorkbookName = CCDetail.Name
CCDetail.Activate
Set RAWData = Worksheets("Department Totals")
RAWData.Select
'This is where the code will break
Range( _
"D:D,E:E,F:F,M:M,X:X,Y:Y,Z:Z,AA:AA,AC:AC,AD:AD,AE:AE,AF:AF,BD:BD,BF:BF," _
).Select
Selection.Copy
Harvester.Activate
Sheets.Add After:=Sheets(Worksheets.Count), Count:=1
ActiveSheet.Name = WorkbookName
ActiveSheet.Paste
End Sub
*As a side note- I have tested doing this manually and I don't have a problem. I have also tried calling
ActiveSheet.Range (wanted Range)
RAWData.Range (wanted range)
But neither of these have worked.
The problem is that you have an extra comma in the arguments for your Range. Try this instead:
Range("D:D,E:E,F:F,M:M,X:X,Y:Y,Z:Z,AA:AA,AC:AC,AD:AD,AE:AE,AF:AF,BD:BD,BF:BF").Copy
If you want to clean up your code a bit and avoid Selects and such, try this out:
Sub ExtractCCDetail()
Dim WorkbookName As String
Dim CCDetail As Workbook
Dim Harvester As Workbook
Dim RAWData As Worksheet
Set CCDetail = Workbooks(2)
Set Harvester = ThisWorkbook
WorkbookName = CCDetail.Name
Set RAWData = CCDetail.Worksheets("Department Totals")
RAWData.Range("D:D,E:E,F:F,M:M,X:X,Y:Y,Z:Z,AA:AA,AC:AC,AD:AD,AE:AE,AF:AF,BD:BD,BF:BF").Copy
Dim wksCopy As Worksheet
Set wksCopy = Harvester.Sheets.Add(After:=Sheets(Worksheets.Count), Count:=1)
With wksCopy
.Paste
.Name = WorkbookName
End With
End Sub