Copy Paste Formulas Using Vba

Sub copyrow()

Dim EndRow
EndRow = Range("B65536").End(xlUp).Row

Range("e" & EndRow + 1, "k" & EndRow + 1).Value = Range("e" & EndRow, "k" & EndRow).Value

End Sub

Public Sub CopyCDSValues()
Dim endrow As Long
Sheets("Sheet1").Select
Range("C29:C35").Copy
Sheets("Peer 5YR CDS").Select
endrow = Range("a65536").End(xlUp).Row - 1
Range("A" & endrow).Value = "Peer Comparative CDS Spreads"
Range("B" & endrow).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
Range("A" & endrow + 1).EntireRow.Insert
Sheets("Blackberry").Select
endrow = Range("z65536").End(xlUp).Row + 1
Range("AA" & endrow).Value = "Peer Comparative CDS Spreads"
Range("AH" & endrow).Select
###Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone,
        SkipBlanks:=False, Transpose:=True

End Sub

    Dim EndRow As Integer
    EndRow = Sheet3.Range("a65536").End(xlUp).Row
    Cells(EndRow + 1, 3).Value = "Test"
    Cells(EndRow + 1, 4).Activate
    ActiveCell.Formula = "=SUM(D:D)"

Sheets("ReconciliatedDATACALCS").Activate
calc_data_last_row = ActiveSheet.Range(Cells(EndRow + 4, acqlast + 2), Cells(EndRow + 4, totalnow))
calc_data_final_row = ActiveSheet.Range(Cells(EndRow + 4, acqlast + 2), Cells(LastDataRow + 4, totalnow))

calc_data_final_row = Sheets("ReconciliatedDATACALCS").Range(Cells(EndRow + 4, acqlast + 2), Cells(LastDataRow + 4, totalnow))
calc_data_last_row = Sheets("ReconciliatedDATACALCS").Range(Cells(EndRow + 4, acqlast + 2), Cells(EndRow + 4, totalnow))

Private Sub CommandButton2_Click() 'Tax Form Button - captures all sales for year

Sheet3.Activate

ActiveSheet.Unprotect
   

Dim lastrow3 As Long
lastrow3 = Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp).Row

If Cells(4, "A") = "" Then
Else
Sheets("Sheet3").Range(Cells(4, "A"), Cells(lastrow3, "H")).Select
Selection = ""

Sheets("Sheet3").Range(Cells(lastrow3, "B"), Cells(lastrow3, "H")).Select
    
     With Selection.Borders(xlEdgeTop)
        .LineStyle = none
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = none
    End With
End If



Sheet1.Activate
Dim i As Integer, rng As Range
Dim lastrow As Long, nextrow As Long
Dim Title As String
Title = ("MY WESTJET SHARES - TAX REPORT FOR " & TextBox1.Text)
lastrow = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
nextrow = Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp).Row + 1

Set rng = Sheets("Sheet1").Range("T4:T" & lastrow)

    For i = 4 To lastrow
    
            If Cells(i, "T").Value = TextBox1.Text And Cells(i, "C").Value = "Sell" Then
            
            'Range(Cells(i, "A"), Cells(i, "L")).Copy Destination:=Sheets("Sheet3").Cells(nextrow, "A")
            
            Sheets("Sheet3").Cells(nextrow, "A").Value = Range(Cells(i, "A"), Cells(i, "A")).Value 'Date
            Sheets("Sheet3").Cells(nextrow, "B").Value = Range(Cells(i, "E"), Cells(i, "E")).Value 'Share Price
            Sheets("Sheet3").Cells(nextrow, "C").Value = Range(Cells(i, "G"), Cells(i, "G")).Value '#Shares Sold
            Sheets("Sheet3").Cells(nextrow, "D").Value = Range(Cells(i, "I"), Cells(i, "I")).Value 'Price Sold For
            Sheets("Sheet3").Cells(nextrow, "E").Value = Range(Cells(i, "K"), Cells(i, "K")).Value 'ACB/Share
            Sheets("Sheet3").Cells(nextrow, "G").Value = Range(Cells(i, "J"), Cells(i, "J")).Value 'Capital Gain/Loss
            Sheets("Sheet3").Cells(nextrow, "H").Value = Range(Cells(i, "D"), Cells(i, "D")).Value 'Sales Fee
            Sheets("Sheet3").Cells(nextrow, "I").Value = Range(Cells(i, "P"), Cells(i, "P")).Value 'Date 1st
            Sheets("Sheet3").Cells(nextrow, "J").Value = Range(Cells(i, "Q"), Cells(i, "Q")).Value 'Date last
            
            'Sheets("Sheet3").Cells(nextrow, "I").Value = Range(Cells(i, "I"), Cells(i, "L")).Value
            'Sheets("Sheet3").Cells(nextrow, "J").Value = Range(Cells(i, "J"), Cells(i, "L")).Value
            'Sheets("Sheet3").Cells(nextrow, "K").Value = Range(Cells(i, "K"), Cells(i, "L")).Value
            
            'Sheets("Sheet3").Cells(nextrow, "A").Resize(1, 12).Value = Range(Cells(i, "A"), Cells(i, "L")).Value
            
           
            
            nextrow = nextrow + 1
        End If
    Next i

Sheet3.Activate


    
    Dim EndRow As Long
    EndRow = Sheet3.Cells(Rows.Count, "A").End(xlUp).Row
    Cells(EndRow + 1, 1).Value = "Totals"
    
    
    Dim r As Long

r = Cells(Rows.Count, "B").End(xlUp).Row

Range("F2").Copy
Range("F2").AutoFill Destination:=Range("F2", ("F4:F" & EndRow))


Cells(3, "F").Value = "Adj. Cost Base"
    
    
    Cells(EndRow + 1, 3).FormulaR1C1 = "=SUM(R1C:R" & EndRow & "C)"
    Cells(EndRow + 1, 4).FormulaR1C1 = "=SUM(R1C:R" & EndRow & "C)"
    Cells(EndRow + 1, 6).FormulaR1C1 = "=SUM(R1C:R" & EndRow & "C)"
    Cells(EndRow + 1, 7).FormulaR1C1 = "=SUM(R1C:R" & EndRow & "C)"
    Cells(EndRow + 1, 8).FormulaR1C1 = "=SUM(R1C:R" & EndRow & "C)"
    Cells(1, 5).Value = Title
    
    'Range("A" & Rows.Count).End(xlUp).Select
    Sheets("Sheet3").Range(Cells(nextrow, "B"), Cells(nextrow, "H")).Select
    
     With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlDouble
        .ColorIndex = xlAutomatic
        .Weight = xlThick
    End With

Range("A" & Rows.Count).End(xlUp).Select 'Selects the last cell in column A (used to deselect previous selection)
'Unload Me

   
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

REPORTS.CommandButton3.Visible = True

End Sub

Hello All,

I currently have some code to pull information from a row on one sheet, transfer it into another and print that sheet. The trouble is I can have around 20 different lines which then gives me 20 different print requests. I want to be able to print it all in one request.

Code:

Sub PrintForms()
    Dim StartRow As Integer
    Dim EndRow As Integer
    Dim Msg As String
    Dim i As Integer
    
    Sheets("Form").Select
    StartRow = Range("StartRow")
    EndRow = Range("EndRow")
    
    i = 0
    
    If StartRow > EndRow Then
        Msg = "ERROR" & vbCrLf & "The starting row must be less than the ending row!"
        MsgBox Msg, vbCritical, APPNAME
    End If
    
    For i = StartRow To EndRow
        Range("RowIndex") = i
        If Range("Preview") Then
            ActiveSheet.PrintPreview
        Else
            ActiveSheet.PrintOut
        End If
    Next i
End Sub

I know its the ActiveSheet bit that I'm struggling with, and I think I need to put the count of the sheets into an array and print the array. I'm just not sure how to do this within VBA code. Any help or pointers in the right direction would be much appreciated!

This is my code. I can't set the series values. (Some code commented out for troubleshooting.) Thanks.

Code:

Sub UpdateChart()
Dim EndRow As Integer
Dim AddR As String
Dim chart As chart

Worksheets("Data").Activate
EndRow = Range("A" & Rows.Count).End(xlUp).Row

    Worksheets("Scorecard").ChartObjects("YTY").Activate
    ActiveChart.SeriesCollection(1).XValues = "=Data!$A$" & EndRow - 51 & ":$A$" & EndRow
    ActiveChart.SeriesCollection("Shipped").Values = "=Data!$C$" & EndRow - 51 & ":$C$" & EndRow
    ActiveChart.SeriesCollection("Received").Values = "=Data!$G$" & EndRow - 51 & ":$G$" & EndRow
    ActiveChart.SeriesCollection("On Hand").Values = "=Data!$I$" & EndRow - 51 & ":$I$" & EndRow

End Sub

Ok, before any one shoots me down, i have looked around the forum and the internet for a answer, Im im half way there.

I have a column in my worksheet which contains alphanumeric data, I also have a Custom menu option to sort the worksheet but 3 columns.

No i know if i have a column contains the following

1
1
2a
3b
3c
2

and i have set the cells to text then it would sort as follows

1
1
2
2a
3c
3b

Which is cool but i have a colum looking like this

3
3
3
8
8a
8b
65a
65
71
71

and when sorted looks like this

3
3
3
65
65a
71
71
8
8a
8b

this is because excel is using the first digit, but i need it to sort as whole numbers so it would look like below

3
3
3
8
8a
8a
65
65a
71
71

Any ideas, I need this to be included in teh VBA code i have for sorting

Code:

Sub SortSpecial()
Dim FirstRow As Long, EndRow As Long, LastRow As Long
ActiveSheet.Protect Password:="gideon", UserInterfaceOnly:=True
LastRow = Range("B" & Rows.Count).End(xlUp).Row
FirstRow = Range("D1").End(xlDown).Row



    Do
        If FirstRow > LastRow Then Exit Sub
        
        EndRow = Range("D" & FirstRow).End(xlDown).Row
        Range("B" & FirstRow, "P" & EndRow).Sort Key1:=Range("D" & FirstRow), Order1:=xlAscending, _
            Key2:=Range("E" & FirstRow), Order2:=xlAscending, _
            Key3:=Range("H" & FirstRow), Order3:=xlAscending, _
            Header:=xlGuess, OrderCustom:=1, _
            MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _
            DataOption2:=xlSortNormal
        FirstRow = Range("D" & EndRow).End(xlDown).Row
    Loop
    
 
    
End Sub

Thanks G

The macro below is designed to print several reports. It prints a report for each ID number listed in a specific column. It works fine except when the print box opens the cancel button does not work. If I decide I want to change something and hit cancel it prints anyways. Can anyone help solve how I can get the cancel button to stop printing and just cancel? Please keep in mind I am a beginner with VBA. Thanks for any help.

Code:

Dim endrow As Long
Application.Dialogs(xlDialogPrinterSetup).Show
    endrow = Cells(Rows.Count, "A").End(xlUp).Row
 For i = 2 To endrow
    If Cells(i, 1).Value <> "" And Cells(i, 1).Value <> " " Then
         Range("L6").Value = Cells(i, 1).Value
         Sheets("Report").PrintOut Copies:=1, Collate:=True
   End If
 Next i
End Sub

Hello everyone. I am trying to simplify a printing function in on one of my worksheets. It is a report that needs to be printed for multiple people. I am a beginner at VBA and the code below basically takes all the ID numbers from column "A" and pastes them into "M2" to print. What it does not do is print these pages to a PDF printer. Can anyone help me modify this code to be able to print each page to one PDF file?

Thanks for any help.


Code:

Sub Mailmerge_3()
Dim endrow As Long
If Application.Dialogs(xlDialogPrinterSetup).Show = False Then Exit Sub
Application.Dialogs(xlDialogPrinterSetup).Show
    endrow = Cells(Rows.Count, "A").End(xlUp).Row
 For i = 2 To endrow
    If Cells(i, 1).Value <> "" And Cells(i, 1).Value <> " " Then
         Range("M2").Value = Cells(i, 1).Value
         Sheets("Report").PrintOut Copies:=1, Collate:=True
   End If
 Next i
End Sub

Hi Could someone please have a look at my loop and tell me where i'm going wrong

I seem to hit an error when it hits

Rows("StartRow:EndRow").Select.

Heres the whole thing

Sub insert_rows()

Dim StartRow As Integer, EndRow As Integer
Sheets("lodgement").Select
StartRow = 2136
EndRow = 2141

Do
Rows("StartRow:EndRow").Select

Selection.Insert Shift:=xlDown

StartRow = StartRow + 7
EndRow = EndRow + 7
Loop Until StartRow = 2150


End Sub



Thanks
S

I was provided with the code below, which work exactly how i want it to and a big thanks to the forum member that took therir time in writing it for me.

But when i run this marco, i get a Password msgs box appear, now is there away of running it so that it does not ask for a password, I have tried to unprotect the sheet with a password which works, but it never re-protected it self,

I don't know that much about VBA and my programming knowledge is very limited. I dont want the code re-written, as its someone elses work and it does what i want, i just need to know if an extra line can be entered to stop the password msg box. I.E. it needs to run without asking for the password


Code:

Sub SortSpecial()
Dim FirstRow As Long, EndRow As Long, LastRow As Long
ActiveSheet.Protect UserInterfaceOnly:=True
LastRow = Range("B" & Rows.Count).End(xlUp).Row
FirstRow = Range("D1").End(xlDown).Row



    Do
        If FirstRow > LastRow Then Exit Sub
        
        EndRow = Range("D" & FirstRow).End(xlDown).Row
        Range("B" & FirstRow, "P" & EndRow).Sort Key1:=Range("D" & FirstRow), Order1:=xlAscending, _
            Key2:=Range("E" & FirstRow), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, _
            MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _
            DataOption2:=xlSortNormal
        FirstRow = Range("D" & EndRow).End(xlDown).Row
    Loop
    
 
   
End Sub

I am creating a 12 month Rental Coupon and am trying to modify the printing macro in my book.

The document is set up to find the data from the last page in the document and fill in 11 consecutive sheets with what the charges will be for a full year. So there are 13 sheets Jan-Dec and then the data sheet. Aditionally the printing macro that allows me to print more than one record.

So I can print record 3-5 (row 3-5 on the data sheet) out of 80, but my macro is only set to print the form "January", but I need it to print Jan-Dec so the end result would be Tenant 3 Jan-Dec, Tenant 4, Jan-Dec, and Tenants 5, Jan-Dec. So the end result would be 36 sheets.

Any help would be appreciated

This is the current macro:

Sub PrintForms()
Dim StartRow As Integer
Dim EndRow As Integer
Dim Msg As String
Dim i As Integer

Sheets("Form").Activate
StartRow = Range("StartRow")
EndRow = Range("EndRow")

If StartRow > EndRow Then
Msg = "ERROR" & vbCrLf & "The starting row must be less than the ending row!"
MsgBox Msg, vbCritical, APPNAME
End If

For i = StartRow To EndRow
Range("RowIndex") = i
If Range("Preview") Then
ActiveSheet.PrintPreview
Else
ActiveSheet.PrintOut
End If
Next i
End Sub

Sub EditData()
Worksheets("Data").Activate
Range("A1").Select
End Sub

Sub ReturnToForm()
Worksheets("Form").Activate
Range("RowIndex").Select
End Sub

I thought that i posted this yesterday but I can't find the posting so
if this is a double post, please point me in the direction of the
original post and I will go from there.

I have the following Code:

Sub Autofill()
'
'
Range("B1").Select
Selection.Copy
Selection.AutoFill Destination:=Range("B1:B10")
Range("B1:B10").Select
Range("G17").Select
End Sub

I looked at previous postings on this group and found this topic
addressed before and I found code on how to do this so I attempted to
apply the following code:

Sub Test()
'
' Test Macro
'
Range("B1").Select
Dim endRow As Long
endRow = Cells(Rows.Count, ("B1:B")).End(xlUp).Row
ActiveCell.AutoFill Destination:=Range("B1:B")
End Sub

However, it keeps errorring out, any suggestions?

Thank you.

Richard

hi

I am pasting code below.Can anybody please help me to reduce the performance.Right now it is taking 20 secs for 90000 rows of data.Can it be reduced furthur in case of perfomance by modifying the code using any other functions.


Her we have used Countif function,so can be furthur tuned and make the macro to run at a faster rate.


Please help me at the earliest.


Code:

Public Sub MultipleUserAppDates_coloring()

Dim startrow As Long
Dim rownumber As Long
Dim lastrownumber As Long
Dim endrow As Long
Dim LoopCtrl As Variant
Dim strRange As String
Dim rng As Range
Dim rngCount As Long
Dim IsValueDifferent As Boolean



lastrownumber = ReturnLastRow(AllEntriesFlagged)
'lastrownumber = AllEntriesFlagged.UsedRange.Rows.count
For rownumber = 43 To lastrownumber
   If Cells(rownumber, 2).Value = "Entry" Then
    rownumber = rownumber + 1
    startrow = rownumber
    While Cells(rownumber, 2).Value <> "Entry" And rownumber <= lastrownumber
        rownumber = rownumber + 1
    Wend
    rownumber = rownumber - 1
    endrow = rownumber
            
        For Each LoopCtrl In Array("M", "N", "P", "Q", "S")
            IsValueDifferent = False
          For counter = startrow + 1 To endrow
            If Cells(startrow, LoopCtrl) <> Cells(counter, LoopCtrl) Then
                IsValueDifferent = True
                Exit For
            End If
           Next
           With Application.WorksheetFunction
            Set rng = Range(Cells(startrow, LoopCtrl), Cells(endrow, LoopCtrl))
            rngCount = endrow - startrow + 1
                If rngCount = .CountIf(rng, Range(LoopCtrl & startrow)) Then
                    rng.Font.Color = vbWhite
                 End If
            End With
        Next LoopCtrl
     
 End If
Next

End Sub

Thnak you.

I use the following code to place values from a Userform onto the next available row on a worksheet. It works fine, but how can I start from Row 10 and finish at Row 90, then go onto a different worksheet?


Private Sub CommandButton1_Click()

Dim History As Worksheet
Dim EndRow As Long
Set History = Sheets("MOVEMENT HISTORY")

EndRow = History.Cells(Rows.Count, "A").End(xlUp).Row + 1
History.Range("A" & EndRow).Value = TextBox1.Value
History.Range("B" & EndRow).Value = TextBox2.Value
History.Range("C" & EndRow).Value = TextBox3.Value

End Sub

Hi everyone,

I am struggling to get this work. Basically what I want is :

-you click on the combobox in sheet 1

-the assigned Macro depending on the combobox value applies a formula (there are two different formulae) using a range of cells value located in sheet 2 to a range of cells located in sheet 3.

Here is my attempted VBA Code:
Code:

Sub Appeler()

With Sheets("Sheet1")

     If .Range("G2") = 1 Then
       Call Macro1
     ElseIf .Range("G2") = 2 Then
       Call Macro2     

     Else
       Range("A1").Select
     End If
End With
End Sub



Sub Macro1()

Dim StartRow As Integer
Dim StartColumn As Integer
Dim EndRow As Integer

StartRow = 2
EndRow = 5
StartColumn = 2
    
    Sheets("Sheet3").Range(Cells(StartRow, StartColumn), Cells(EndRow, StartColumn)).FormulaR1C1 = "='Sheet2'!R1C1:R3C1*'Sheet2'!R1C2"

End Sub



Sub Macro2()

Dim StartRow As Integer
Dim StartColumn As Integer
Dim EndRow As Integer

StartRow = 2
EndRow = 5
StartColumn = 2
    
    Sheets("Sheet3").Range(Cells(StartRow, StartColumn), Cells(EndRow, StartColumn)).FormulaR1C1 = "='Sheet2'!R1C1:R3C1*'Sheet2'R1C3"

End Sub

I have a problem to use the formulae using the cell values in one sheet to the cell of another sheet, I keep getting the message "application-defined or object-defined error".

and I am confused about how to write the formulae since I want for example in Macro2 :
'Sheet3'!R2C2 = 'Sheet2'!R1C1* 'Sheet2'!R1C3"
'Sheet3'!R3C2 = 'Sheet2'!R2C1* 'Sheet2'!R1C3"
'Sheet3'!R4C2 = 'Sheet2'!R3C1* 'Sheet2'!R1C3"


Hope I've made myself clear enough

Thanks for any help

Hey guys,

Here is some background about me and this project I am working on. I am a college grad that just recieved his first position. My job is to go through this workbook that is broken from the database and begin rewriting some programming to make it automated again. I've reached my first stump, I hope you guys can help!


The spreadsheet consist of the previous year's last quarter, and the current year's 4 quarters. The macros will take whatever is in the last column (Previous year's last quarter), copy it, and paste it into the correct column. Next, it would clear everything else. There is 4 different worksheets that it will automate through. For some reason, I keep getting inconsistant results with this macros and I cannot figure it out.

Code:

Option Explicit

Sub resetAll()
Dim copyStr As String
Dim pasteStr As String
Dim i As Integer
Dim rng As String
Dim startRng As String
Dim endRng As String
'Dim pos1 As Integer
Dim pos2 As Integer
Dim endRow As Range

Dim startRow As Integer
Dim kpiWS As Worksheet
Dim flg As Integer
Dim msg As String

Application.ScreenUpdating = False


msg = MsgBox("This action clears all the columns EXCEPT last QDec column. Do you still want to reset?", vbYesNoCancel + vbExclamation, "Reset Warning")

If msg = vbYes Then
    copyStr = ActiveWorkbook.Worksheets("Config").Range("H5").Value 'S:U
    pasteStr = ActiveWorkbook.Worksheets("Config").Range("G5").Value 'G:I
     
    'pos1 = InStr(pasteStr, ":")
    pos2 = InStr(copyStr, ":")

    startRng = ActiveWorkbook.Worksheets("Config").Range("I5").Value
    endRng = Mid(copyStr, pos2 + 1)


    For i = 2 To 5 '####### i value hardcoded - 4 KPI regions
        rng = "L" & i
        'get the worksheet name to enter the data
        Set kpiWS = ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets("Config").Range(rng).Value)
    
        'copy from QDEC and copy to QDEC...
        With kpiWS
            .Activate
            .Columns(copyStr).Copy
            .Columns(pasteStr).Select
            .Paste
        End With
    
        startRow = 4
    
        'delete the rest
        With kpiWS
            .Activate
            Set endRow = .Columns(1).find(What:="Title", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
        
            If Not endRow Is Nothing Then
                flg = endRow.Row
                Do
                    .Range(startRng & startRow & ":" & endRng & endRow.Row).ClearContents
                    startRow = endRow.Row + 4
            
                    Set endRow = .Columns(1).FindNext(endRow)
                Loop Until flg = endRow.Row
            
            End If
        
        
        End With

    Next i


    Call setColumnHead  'sets the column headers by quarters and QCRs
    
    MsgBox "Reset Complete!!"

End If

    ActiveWorkbook.Worksheets("MainSheet").Activate
    Application.ScreenUpdating = True

    
End Sub

Any ideas? questions?
Thanks!

Dear all,

For a task-list I made in excel I use a dropdown where users can choose their name, and see their personal tasks verry easy. (As it sometimes happend that on one job Member 1 is a junior, and on the other job Member 1 is a senior, I didn't want to work with the filter-system)

I manage this true following code:

Code:

Sub Personal_view()
    BeginRow = 3
    Col_junior = 39
    Col_senior = 40
    Col_manager = 41
    
    EndRow = Range("B65536").End(xlUp).Row
    For RowCnt = BeginRow To EndRow
        
    ' All team members - 1
    
    If Cells(1, 6).Value = "1" Then
    
           Cells(RowCnt, 1).EntireRow.Hidden = False
    
    End If
    
    ' Member 1

    If Cells(1, 6).Value = "2" Then
        
        If Cells(RowCnt, Col_junior).Value = "MB1" Then
           Cells(RowCnt, 1).EntireRow.Hidden = False
        Elseif Cells(RowCnt, Col_senior).Value = "MB1" Then
           Cells(RowCnt, 1).EntireRow.Hidden = False
        Elseif Cells(RowCnt, Col_manager).Value = "MB1" Then
           Cells(RowCnt, 1).EntireRow.Hidden = False
        Else
           Cells(RowCnt, 1).EntireRow.Hidden = True
        End If
    
    End If
    
    ' Member 2

    If Cells(1, 6).Value = "3" Then
        
        If Cells(RowCnt, Col_junior).Value = "MB2" Then
           Cells(RowCnt, 1).EntireRow.Hidden = False
        Elseif Cells(RowCnt, Col_senior).Value = "MB2" Then
           Cells(RowCnt, 1).EntireRow.Hidden = False
        Elseif Cells(RowCnt, Col_manager).Value = "MB2" Then
           Cells(RowCnt, 1).EntireRow.Hidden = False
        Else
           Cells(RowCnt, 1).EntireRow.Hidden = True
        End If
    
    Next RowCnt
    
End Sub

As I use my name 'Member 1', it displays exactly what I want; it hides all other lines.
But if I want to go back, and choose for another member's name, the script doesn't work.

Also when I want to show everyone's workload, I can't go back to this view...

The fault is probably in the 'Cells(RowCnt, 1)' code, but I don't know how I can solve this.
I managed to do this when I change at the beginning "EndRow = Range("B65536").End(xlUp).Row" into "EndRow = 1000", but I don't want that Excel is going to hide rows where there are no tasks in it (no content in column B).

Can anyone please help me?

Thank you all in advance.


Edit: Is there perhaps a more simple method as my code above? And this because I have about 30 - 40 members... Thanks!

Hi guys,

(Hopefully) quick question for you. I'm trying to use SumIf and it's been giving me a heck of a time all afternoon. I've tried using the worksheetfunction.sumif route and couldn't seem to get the syntax correct. I'd prefer the worksheetfunction route, as I don't need the formula stored, but it would be great to have both of these pieces of code for reference online - I scoured Google, and the examples I found were pretty weak.

I've recorded the macro (hence the R1C1 references in the second example) and had it work perfectly, but when I replaced row references with my variables, it went back to displaying "TRUE." I'm including all the code here.

Variables:
expr = 3 to 38 (For loop)
startrow = the starting row for the reference data
endrow = the ending row for the reference data
thresh = minimum threshold (a number)

Syntax error he

Code:

ThisWorkbook.Worksheets("Sheet2").Cells(8, expr).Formula = worksheetfunction.SumIf(ws.Range("D" & startrow & ":D" & endrow),"">"" & thresh ,ws.Range("F" & startrow & ":F" endrow))

Returns "TRUE" instead of the sum I'm looking for:

Code:

ThisWorkbook.Worksheets("Sheet2").Cells(8, expr).FormulaR1C1 = "=sumif(daily!R[" & startrow & "]C[4]:R[" & endrow & "]C[4],""" > "" & thresh & ",daily!R[" & startrow & "]C[F])"

Recorded macro that works:

Code:

ActiveCell.FormulaR1C1 = "=SUMIF(daily!R[24]C[1]:R[42]C[1],"">"" & daily!R[8]C[1],daily!R[24]C[3])"

Thanks for all your help! Love the forum... It's been a great resource and I hope to one day be on the other end of the questions when I get a little better at this. :-/

Hello,

I have a macro that cycles through several student ID numbers and prints a progress report for each one. It works great, but I would like to add an option to pick which printer to use at the beginning of the code. In other words, when I run the macro, the printer box opens and I can pick the printer. When I click okay to print, the macro continues. Any ideas?

Code:

    Range("A65536").Select
    Selection.End(xlUp).Select
    endrow = ActiveCell.Row
    For i = 2 To endrow
    If Cells(i, 1).Value <> "" And Cells(i, 1).Value <> " " Then
    Range("L6").Value = Cells(i, 1).Value
    '  Sheets("Report").PrintPreview
    Sheets("Report").PrintOut Copies:=1, Collate:=True
   End If
    Next i

Hi,

I have a similar problem to the one solved in the link below.

http://www.officekb.com/Uwe/Forum.as...ate-like-sumif

This is involving concatenating several text lines when they show a matching reference. E.G if column a shows "LT_001", then concatenate the comments of all with same referance. I had intended to copy out the formula used, and adjust it to fit my situation, but if I copy the formula into VBA it does not allow me to run the function.

I have the same problem with most VBA code taken from the internet and can't figure out what I should be doing? I have literally copied the formula as is, bar changing "A7" to "A2". As I am trying to adjust the formula to fit, for the moment my workbook has example data in columns A, B, and C, and a consolidated list of column A in Column G.

This is the function I have copied from the page:

Public Function Test(TruckNo) As String
Dim EndRow As Long
Dim NN As String
Dim x As Long

EndRow = Range("A7").End(xlDown).Row

For x = 7 To EndRow
If Cells(x, 1).Value = TruckNo Then NN = NN & Cells(x, 2).Value _
& " : " & Cells(x, 3).Value & Chr(10)
Next x

NN = Left(NN, Len(NN) - 1)

Test = NN

End Function

Do I need to change some of this text in order to make this run?

As is blindingly obvious, I have no idea what I am doing in VBA, so any help on why I can't get things to work is hugely appreciated.

Thank you,

Larisa

Hello,

I have an existing chart on a worksheet for which I am trying to update the
XValues for each series. The update works for the first series that I want
to change, but on the subsequent ones, it raises a Runtime Error 1004. The
original values in each series are all valid. If I swap the series around
(so that the second and third are before the first) then the error occurs
immediately.

Below is a cut-down version of the code I am using. The startrow and endrow
variables are normally populated from elsewhere.

If anyone could give me a pointer as to why it works for the first series
but fails on all subsequent ones I would be grateful.

Set CHT = Worksheets("Chart").ChartObjects("Chart 1").Chart

startrow = 152
endrow = 196

Value1 = "='Overall Progress - Tabular'!R" & startrow & "C6:R" & endrow & "C6"
Value2 = "='Overall Progress - Tabular'!R" & startrow & "C8:R" & endrow & "C8"
Value3 = "='Overall Progress - Tabular'!R" & startrow & "C10:R" & endrow &
"C10"

CHT.SeriesCollection("Cumulative Actual").XValues= Value1
CHT.SeriesCollection("Cumulative Predictive Failed").XValues = Value2
CHT.SeriesCollection("Cumulative Actual Failed").XValues = Value3

Data has been autofiltered using VBA. I need to write a macro to count the number of rows in column A that are >= "7/16/1981" and in column B <= "7/16/1981".

I have tried Evaluate(sumproduct(...)), worksheetfunction.sumproduct, etc. a hundred different ways to no avail.

Would greatly appreciate any advice, examples using .Range("A2:A" & endRow) and .Range("B2:B" & endRow) inside a CountIf or SumProduct function in VBA.

V/r,
Mac

When I used the following lines to adjust the range of a chart:
If EndRow > StartRow Then
ActiveSheet.ChartObjects("EnvGraph").Activate
ActiveChart.SeriesCollection(1).XValues = Range("A" & StartRow & ":A" &
EndRow)
ActiveChart.SeriesCollection(1).Values = Range(Col1(ColNum) & StartRow
& ":" & Col1(ColNum) & EndRow)
ActiveChart.SeriesCollection(2).XValues = Range("A" & StartRow & ":A" &
EndRow)
ActiveChart.SeriesCollection(2).Values = Range(Col2(ColNum) & StartRow
& ":" & Col2(ColNum) & EndRow)
Range("A1").Activate
End If

I got the following run-time error message:
Run-time error '-2147221080 (800401a8)':
Method 'SeriesCollection' of object '_Chart'failed

I suspect that this is due to the use of the sheet.add method:
For i = 1 To InputCaseNum
If RunThisCase(i) = True Then
Sheets.Add Type:=InputTemplate(i)
End If

Because I didn't get the runtime error when I use the Worksheets.Copy method:
Worksheets(InputTemplate(i)).Copy after:=Worksheets(Worksheets.Count)


How could I resolve this problem?