I have a button in a sheet named "INPUT". However, the code should be acting upon data located in a different sheet named "SUMBER" when I click that button. How do I do this?
Dim osh As Worksheet
Dim iRow As Long
Dim iCol As Long
Dim iFirstRow As Long
Dim iTotalRows As Long
Dim iStartRow As Long
Dim iStopRow As Long
Dim sSectionName As String
Dim rCell As Range
Dim owb As Workbook
Dim sFilePath As String
Dim iCount As Integer
Dim Response As Integer
Dim sFName As String
iCol = Worksheets("input").Range("B4")
iRow = Worksheets("input").Range("B5")
iFirstRow = iRow
Set osh = Application.ActiveSheet
Set owb = Application.ActiveWorkbook
iTotalRows = osh.UsedRange.Rows.Count
sFilePath = Application.ActiveWorkbook.Path
I've been trying to change these lines:
Set osh = Application.ActiveSheet
Set owb = Application.ActiveWorkbook
But it has not worked.
declare and set workbook and your sheets like this:
Dim owb as Workbook
Dim oshInput, oshSumber as Worksheet
Set owb = Thisworkbook
Set oshInput = owb.Sheets("Input")
Set oshSumber = owb.Sheets("Sumber")
then add what you want to do.
For example your line:
iCol = Worksheets("input").Range("B4")
iRow = Worksheets("input").Range("B5")
once you did the above declaration and set will be:
iCol = oshInput.Range("B4")
iRow = oshInput.Range("B5")
hope this helps and get's you started a bit.
Related
I have some code which I want to share with other users and so when they run the workbook from their Downloads folder, I want each user to be able to run it. Basically username1 will change for each user.
I tried the examples -> HERE
Here is the code I have:
Sub CopyTime()
Dim rFind As Range
Dim rDelete As Range
Dim strSearch As String
Dim iLookAt As Long
Dim bMatchCase As Boolean
Dim WS7 As Worksheet
Const csvFile = "C:\Users\username1\Downloads\Login_Logout_Report.csv"
Dim ws As Worksheet, csv As Workbook, cCount As Long, cName As String
Dim wb1 As Excel.Workbook
Set wb1 = Workbooks.Open("C:\Users\username1\Downloads\ShiftTime.xlsm")
' Other code goes here
End Sub
Here is what I have tried
Const csvFile = "C:\Users\" & Environ("UserName") & "\Downloads\Login_Logout_Report.csv"
Dim ws As Worksheet, csv As Workbook, cCount As Long, cName As String
Dim wb1 As Excel.Workbook
Set wb1 = Workbooks.Open("C:\Users\" & Environ("UserName") & "\Downloads\ShiftTime.xlsm")
With the code below, I define an array of worksheets and run a For-Each-Loop over that array. I don't understand why I have to declare the variable wsArray as variant data type. Also, why I can't I just run the For-Each-Loop over the array using the instruction For Each ws In wsArray.
Sub TestWorksheets()
Dim ws As Worksheet
Dim wsArray As Variant
ws = Array("Sheet2", "Sheet3")
For Each ws In Worksheets(wsArray)
' ...do whatever
Next ws
End Sub
Loop Through Several Worksheet
In the first example, the worksheets in wsNamesList have to exist or the loop will cause a run-time error.
In the second more flexible example, only the existing worksheets will be 'processed'.
Option Explicit
Sub TestWorksheets()
Const wsNamesList As String = "Sheet2,Sheet3"
Dim wsNames() As String: wsNames = Split(wsNamesList, ",")
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim ws As Worksheet
For Each ws In wb.Worksheets(wsNames)
Debug.Print ws.Name, ws.UsedRange.Address
Next ws
End Sub
Sub TestWorksheetsMoreFlexible()
Const wsNamesList As String = "Sheet2,Sheet3"
Dim wsNames() As String: wsNames = Split(wsNamesList, ",")
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim ws As Worksheet
Dim n As Long
For n = 0 To UBound(wsNames)
Set ws = Nothing
On Error Resume Next
Set ws = wb.Worksheets(wsNames(n))
On Error GoTo 0
If Not ws Is Nothing Then
Debug.Print ws.Name, ws.UsedRange.Address
End If
Next n
End Sub
EDIT
Sub TestWorksheetsVariant()
Const wsNamesList As String = "Sheet2,Sheet3"
Dim wsNames() As String: wsNames = Split(wsNamesList, ",")
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim nUpper As Long: nUpper = UBound(wsNames)
Dim wss() As Worksheet: ReDim wss(0 To nUpper)
Dim n As Long
For n = 0 To nUpper
Set wss(n) = wb.Worksheets(wsNames(n))
Next n
Dim ws As Variant ' ***
For Each ws In wss
Debug.Print ws.Name, ws.UsedRange.Address
Next ws
End Sub
Sub TestWorksheetsVariantShort()
Dim wsArray As Variant: wsArray = Array("Sheet2", "Sheet3")
Dim ws As Variant ' ***
For Each ws In Worksheets(wsArray)
Debug.Print ws.Name, ws.UsedRange.Address
Next ws
End Sub
why I have to declare the variable wsArray as variant data type
you don't declare the array, you declare a variant which can hold an array.
Array declaration would be something like
Dim wsArray() as String
I want to split one worksheet which has a column named Diameter into many sheets according to the number of diameters found, in my case it is Column C in a Master Sheet,
My code is
Private Sub Splitter()
Dim xl As New Excel.Application
Dim wb As Excel.Workbook
Dim Source As Excel.Worksheet
Dim Destination As Excel.Worksheet
Dim SourceRow As Long
Dim Lastrow As Long
Dim DestinationRow As Long
Dim Diameter As String
xl.Application.ScreenUpdating = False
wb = xl.Workbooks.Open("E:\Patches\Main_Master_VB.xlsm")
Source = wb.Worksheets("Master")
Lastrow = Source.Cells(Source.Rows.Count, "C").End(Excel.XlDirection.xlUp).Row
For SourceRow = 2 To Lastrow
Diameter = Source.Cells(SourceRow, "C").Value
Destination = Nothing
On Error Resume Next
Destination = wb.Sheets(Diameter)
On Error GoTo 0
If Destination Is Nothing Then
Destination = wb.Worksheets.Add(After:=wb.Worksheets(wb.Worksheets.Count))
Destination.Name = Diameter
Source.Rows(1).Copy(Destination.Rows(1))
End If
DestinationRow = Destination.Cells(Destination.Rows.Count, "C").End(Excel.XlDirection.xlUp).Row + 1
Source.Rows(SourceRow).Copy(Destination:=Destination.Rows(DestinationRow))
Next SourceRow
xl.Application.ScreenUpdating = True
End Sub
I receive error Invalid index. (Exception from HRESULT: 0x8002000B (DISP_E_BADINDEX))' at the Line Destination = wb.Sheets(Diameter)
Notice : this code is running with VBA but not running with VB.net
Appreciate your help
Thanks, Regards
Moheb Labib
The following code fixes compilation errors caused by Option Strict disliking late binding. It may help point our what is wrong with the code.
Imports Microsoft.Office.Interop.Excel
Imports Microsoft.Office.Interop
Private Sub Splitter()
Dim xl As New Excel.Application
Dim wb As Excel.Workbook
Dim Source As Excel.Worksheet
Dim Destination As Excel.Worksheet
Dim SourceRow As Long
Dim Lastrow As Long
Dim DestinationRow As Long
Dim Diameter As String
xl.Application.ScreenUpdating = False
wb = xl.Workbooks.Open("E:\Patches\Main_Master_VB.xlsm")
Source = CType(wb.Worksheets("Master"), Worksheet)
Dim RowCount = Source.Rows.Count
Dim LastRowRange = CType(Source.Cells(RowCount, "C"), Range)
Lastrow = LastRowRange.End(Excel.XlDirection.xlUp).Row
For SourceRow = 2 To Lastrow
Dim DiameterRange = CType(Source.Cells(SourceRow, "C"), Range)
Diameter = DiameterRange.Value.ToString
Destination = Nothing
'On Error Resume Next
Destination = CType(wb.Sheets(Diameter), Worksheet)
'On Error GoTo 0
If Destination Is Nothing Then
' (Before, After, Count, Type)
Destination = CType(wb.Worksheets.Add(After:=wb.Worksheets(wb.Worksheets.Count)), Worksheet)
Destination.Name = Diameter
Dim row = CType(Source.Rows(1), Range)
row.Copy(Destination.Rows(1))
End If
Dim DestinationRowRange = CType(Destination.Cells(Destination.Rows.Count, "C"), Range)
DestinationRow = DestinationRowRange.End(Excel.XlDirection.xlUp).Row + 1
Dim SourceRowRange = CType(Source.Rows(SourceRow), Range)
SourceRowRange.Copy(Destination:=Destination.Rows(DestinationRow))
Next SourceRow
xl.Application.ScreenUpdating = True
End Sub
I can't seem to get my two open workbooks to set as variables. I have created a sub that opens the second one, so both now should be open.
But when I step through the code I get:
"rn-time error'438' object doesn't support this property or method.
I have tried both .Select and Activate. Both come back with errors.
have included the sub that opens the second workbook, for reference.
Sub copytoMaster()
Dim wkbk As Workbook
Dim NewFile As Variant
NewFile = "C:\Users\msheppar\Desktop\new holiday project\Master Holiday Tracker.xlsm"
If NewFile <> False Then
Set wkbk = Workbooks.Open(NewFile)
End If
End Sub
Sub CopyAndPaste()
Dim wbpast As Workbook
Dim wbcop As Workbook
Dim xlastrowcopy As Long
Dim xlastrowpast As Long
Dim xlastcolumnn As Long
Dim i As Integer
Dim j As Integer
Dim r As Integer
Dim rname As String
Set wbcop = Workbooks("Holiday form (9).xlsm")
Set wbpast = Workbooks("Master Holiday Tracker.xlsm")
'For i = 1 To xlastrowcopy
wbcop = ActiveSheet
Sheets("sheet4").Select
I am stuck on a line and don´t know how to solve the error. I´m dividing the lines in a list by filtering different names with an advanced filter and copying the data in individual sheets, but got stuck on a line, the last one before the Next: "newWS.Range("A1").Paste". I get error 1004 from debugging:
Private Sub loopfilter()
Dim thisWB As Workbook
Dim filterws As Worksheet
Dim howto As Worksheet
Dim advfilter As Range
Dim Postenws As Worksheet
Dim VersandRange As Range
Dim rng As Range
Dim Name As String
Set thisWB = ThisWorkbook
Set filterws = thisWB.Sheets("Filtro")
Set howto = thisWB.Sheets("How to")
Set advfilter = filterws.Range("A1:AK2")
Set Postenws = thisWB.Sheets("Alle gemahnten Posten (2)")
Set VersandRange = howto.Range("J2", Cells(Rows.Count, "j").End(xlUp))
Dim newWS As Worksheet
For Each rng In VersandRange
filterws.Range("AK2") = rng.Value
Application.CutCopyMode = False
Postenws.Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=advfilter, _
CopyToRange:=filterws.Range("A5"), _
Unique:=False
filterws.Range("a5").CurrentRegion.Copy
Set newWS = thisWB.Sheets.Add
newWS.Name = rng.Value
newWS.Range("A1").Paste
Next
End Sub
Any idea why its not working?
Thanks
Try this (also made a sheet reference to your definition of Versandrange). Paste is not a method of the range object.
Private Sub loopfilter()
Dim thisWB As Workbook
Dim filterws As Worksheet
Dim howto As Worksheet
Dim advfilter As Range
Dim Postenws As Worksheet
Dim VersandRange As Range
Dim rng As Range
Dim Name As String
Set thisWB = ThisWorkbook
Set filterws = thisWB.Sheets("Filtro")
Set howto = thisWB.Sheets("How to")
Set advfilter = filterws.Range("A1:AK2")
Set Postenws = thisWB.Sheets("Alle gemahnten Posten (2)")
Set VersandRange = howto.Range("J2", howto.Cells(Rows.Count, "j").End(xlUp))
Dim newWS As Worksheet
For Each rng In VersandRange
filterws.Range("AK2").value = rng.Value
Application.CutCopyMode = False
Postenws.Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=advfilter, _
CopyToRange:=filterws.Range("A5"), _
Unique:=False
Set newWS = thisWB.Sheets.Add
newWS.Name = rng.Value
filterws.Range("a5").CurrentRegion.Copy newWS.Range("A1")
filterws.Range("a5").CurrentRegion.clearcontents
Next
End Sub