Excel Tips - Change values on multiple sheets

Good morning, I have been struggling with this project for a week now. I am well versed on Excel with some experience in VBA. What I'm trying to do is copy non-adjacent cells/rows from over 100 different sheets into a new sheet in a summary format. I was able to get this to work initially when only copying specific cells in each sheet. When I tried to look at different fields and their values to determine what data I wanted to copy the code was outside of my experience level. So basically what I want to do is copy the following cells in each sheet if there is no date in the cell range between b12:b2000 on each of the sheets. If there is no data then the only cells I would want to copy and paste across a row are cells B7, B5, H7, H8, B9, C9, D9, K7, K8, P8, Q3, Q5. If there is data in the range of b12:b2000 I would want cells B7, B5, H7, H8, B9, C9, D9, K7, K8, P8, Q3, Q5 and the value to the left of what is found in the b12:b2000 range as well as the next two values to the right of column b. This is the code I have so far.
[code]
Sub Button1_Click()
Dim SiteCol As Range, Cell As Object
Dim ws As Worksheet, LR As Integer
Application.ScreenUpdating = False
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "FMS"
Set SiteCol = Range("b12:b2000") 'Range containing values
For Each ws In ThisWorkbook.Worksheets
For Each Cell In SiteCol
With ws
If IsEmpty(Cell) Then
.Range("B7").Copy
Sheets("FMS").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.Range("B5").Copy
Sheets("FMS").Range("B" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.Range("H7").Copy
Sheets("FMS").Range("C" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.Range("H8").Copy
Sheets("FMS").Range("D" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.Range("B9").Copy
Sheets("FMS").Range("E" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.Range("C9").Copy
Sheets("FMS").Range("F" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.Range("D9").Copy
Sheets("FMS").Range("G" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.Range("K7").Copy
Sheets("FMS").Range("H" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.Range("K8").Copy
Sheets("FMS").Range("I" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.Range("P8").Copy
Sheets("FMS").Range("J" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.Range("Q3").Copy
Sheets("FMS").Range("K" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.Range("Q5").Copy
Sheets("FMS").Range("L" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
End If
If Cell.Value > "0" Then
.Range("B7").Copy
Sheets("FMS").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.Range("B5").Copy
Sheets("FMS").Range("B" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.Range("H7").Copy
Sheets("FMS").Range("C" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.Range("H8").Copy
Sheets("FMS").Range("D" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.Range("B9").Copy
Sheets("FMS").Range("E" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.Range("C9").Copy
Sheets("FMS").Range("F" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.Range("D9").Copy
Sheets("FMS").Range("G" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.Range("K7").Copy
Sheets("FMS").Range("H" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.Range("K8").Copy
Sheets("FMS").Range("I" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.Range("P8").Copy
Sheets("FMS").Range("J" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.Range("Q3").Copy
Sheets("FMS").Range("K" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.Range("Q5").Copy
Sheets("FMS").Range("L" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Selection.Value = Cells(Cell.Row, 13).Value
End If
End With
Next
With Worksheets("FMS")
On Error Resume Next
.Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
LR = .Range("A" & Rows.Count).End(xlUp).Row
.Range("A1:B" & LR).Sort Key1:=Range("A1"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
Next ws
End Sub
[\code]

Any help with this would be greatly appreciated.

Good morning, I have been struggling with this project for a week now. I am well versed on Excel with some experience in VBA. What I'm trying to do is copy non-adjacent cells/rows from over 100 different sheets into a new sheet in a summary format. I was able to get this to work initially when only copying specific cells in each sheet. When I tried to look at different fields and their values to determine what data I wanted to copy the code was outside of my experience level. So basically what I want to do is copy the following cells in each sheet if there is no date in the cell range between b12:b2000 on each of the sheets. If there is no data then the only cells I would want to copy and paste across a row are cells B7, B5, H7, H8, B9, C9, D9, K7, K8, P8, Q3, Q5. If there is data in the range of b12:b2000 I would want cells B7, B5, H7, H8, B9, C9, D9, K7, K8, P8, Q3, Q5 and the value to the left of what is found in the b12:b2000 range as well as the next two values to the right of column b. This is the code I have so far.
VB:

Sub Button1_Click() 
    Dim SiteCol As Range, Cell As Object 
    Dim ws As Worksheet, LR As Integer 
    Application.ScreenUpdating = False 
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "FMS" 
    Set SiteCol = Range("b12:b2000") 'Range containing values
    For Each ws In ThisWorkbook.Worksheets 
        For Each Cell In SiteCol 
            With ws 
                If IsEmpty(Cell) Then 
                    .Range("B7").Copy 
                    Sheets("FMS").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats 
                    .Range("B5").Copy 
                    Sheets("FMS").Range("B" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats 
                    .Range("H7").Copy 
                    Sheets("FMS").Range("C" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats 
                    .Range("H8").Copy 
                    Sheets("FMS").Range("D" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats 
                    .Range("B9").Copy 
                    Sheets("FMS").Range("E" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats 
                    .Range("C9").Copy 
                    Sheets("FMS").Range("F" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats 
                    .Range("D9").Copy 
                    Sheets("FMS").Range("G" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats 
                    .Range("K7").Copy 
                    Sheets("FMS").Range("H" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats 
                    .Range("K8").Copy 
                    Sheets("FMS").Range("I" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats 
                    .Range("P8").Copy 
                    Sheets("FMS").Range("J" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats 
                    .Range("Q3").Copy 
                    Sheets("FMS").Range("K" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats 
                    .Range("Q5").Copy 
                    Sheets("FMS").Range("L" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats 
                End If 
                If Cell.Value > "0" Then 
                    .Range("B7").Copy 
                    Sheets("FMS").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats 
                    .Range("B5").Copy 
                    Sheets("FMS").Range("B" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats 
                    .Range("H7").Copy 
                    Sheets("FMS").Range("C" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats 
                    .Range("H8").Copy 
                    Sheets("FMS").Range("D" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats 
                    .Range("B9").Copy 
                    Sheets("FMS").Range("E" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats 
                    .Range("C9").Copy 
                    Sheets("FMS").Range("F" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats 
                    .Range("D9").Copy 
                    Sheets("FMS").Range("G" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats 
                    .Range("K7").Copy 
                    Sheets("FMS").Range("H" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats 
                    .Range("K8").Copy 
                    Sheets("FMS").Range("I" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats 
                    .Range("P8").Copy 
                    Sheets("FMS").Range("J" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats 
                    .Range("Q3").Copy 
                    Sheets("FMS").Range("K" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats 
                    .Range("Q5").Copy 
                    Sheets("FMS").Range("L" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats 
                    Selection.Value = Cells(Cell.Row, 13).Value 
                End If 
            End With 
        Next 
        With Worksheets("FMS") 
            On Error Resume Next 
            .Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete 
            On Error Goto 0 
            LR = .Range("A" & Rows.Count).End(xlUp).Row 
            .Range("A1:B" & LR).Sort Key1:=Range("A1"), Order1:=xlAscending, _ 
            Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom 
        End With 
        Application.CutCopyMode = False 
        Application.ScreenUpdating = True 
    Next ws 
End Sub 

If you like these VB formatting tags please consider sponsoring me in support of injured Royal Marines



Any help with this would be greatly appreciated.

I would like to change the text of a tool/hover tip for a datalabel in a chart
using Excel 2003. As it is, I can use the

Application.ShowChartTipNames
and
Application.ShowChartTipValue

to either turn on or off the names and values. If, say, I turn on
names but not values, then the datalabels for the series named "Category 1"
would read

"Category 1" Data Labels.

That's close, but I'd prefer that the tip simply read

Category 1

or whatever else I choose. Is there a .caption property or some such
that I can change somewhere?

Can this be done?

Thanks,
Rob

Can anyone help me please.This is very urgent.

I have the Output Excel workbook with multiple sheets. The data in the output Excel workbook starts from A1.

I have another Excel workbook named Input with multiple sheets and the sheet names are same in both output and Input files.

Now i need to copy certain rows starting from A1 in Input file from sheet1 to sheet1 of output file.

copy the rows from sheet1 starting from A1 in input file till the common field CORP-MCA-NO or copy all the rows above the field CORP-MCA-NO and paste in the Output file sheet1 above the data(A1) as headers.
Repeat the same with all the sheets i.e.copy sheet1 of Input file to sheet 1 of output file and sheet2 of Input file to sheet2 of output file and so on...

Please let me know if you have any questions

Thanks in advance

I have 4000 rows in 6 columns.
Some of the rows have been mislabeled.
How do I change every row that says "New Products and Services" to "Products and Services" without individually changing each and every one?

Thank you,

Larry G.

When resellers open my price list file, I would like a window to pop up and ask what their markup is, and then apply that markup to all the prices in all the sheets.

The price list file has multiple sheets. All the prices are in the same columns of each sheet, but different rows. Also, the first two sheets in the file are a cover and terms list, so I wouldn't want anything changing on those sheets.

I'm pretty sure this is possible, but I'm having a really hard time figuring out how to do it. Any help would be greatly appreciated!

Hello everyone,

I am looking for some feedback on the code I have written. It is my first attempt at using arrays in code for the purpose of accumulating data, and subesequently using the same data to create a report.

My code below looks at a table that is 10 columns wide and reads all of the data into 10 different arrays - this is where feedback may be useful, should I have used a multi dimensional array (if so show me how please).

After it reads the data into the arrays it looks at the first array and finds the unique items in that array, which are then used to create a nice report outlined by the groupings.

Once again any feedback on ways to improve the code would be great - learning lots.

Thanks

Code:

Option Explicit
Sub investment1()
'Macro to create investment portfolio report - By Gerry on March 9, 2009
    Dim lr As Long, i As Long, j As Long, k As Long, l As Long
    Dim CUname As String, RPdate As String
    Dim grp1() As Variant, grp2() As Variant, grp3() As Variant, grp4() As Variant
    Dim grp5() As Variant, grp6() As Variant, grp7() As Variant, grp8() As Variant
    Dim grp9() As Variant, grp10() As Variant
    Dim hdg() As Variant, hdg1 As Long
    Application.ScreenUpdating = False
'Get the relevant data - 10 columns of data, 1 array for each column
    With Worksheets("Inputs")
        lr = .Cells(.Rows.Count, 1).End(xlUp).Row
        ReDim grp1(1 To lr), grp2(1 To lr), grp3(1 To lr), grp4(1 To lr), grp5(1 To lr)
        ReDim grp6(1 To lr), grp7(1 To lr), grp8(1 To lr), grp9(1 To lr), grp10(1 To lr)

        For i = 8 To lr
        
            grp1(i) = .Cells(i, 1).Value
            grp2(i) = .Cells(i, 2).Value
            grp3(i) = .Cells(i, 3).Value
            grp4(i) = .Cells(i, 4).Value
            grp5(i) = .Cells(i, 5).Value
            grp6(i) = .Cells(i, 6).Value
            grp7(i) = .Cells(i, 7).Value
            grp8(i) = .Cells(i, 8).Value
            grp9(i) = .Cells(i, 9).Value
            grp10(i) = .Cells(i, 10).Value
        Next
    'Get the CU name and report date
        CUname = .Range("A1").Value
        RPdate = Format(.Range("C5").Value, "MMMM DD, YYYY")
    End With

'Get the category headings and count using custom function called UniqueItems
        hdg = UniqueItems(grp1, False)
        hdg1 = UniqueItems(grp1)

Sheets.Add
ActiveSheet.Name = "newSht"


'Set Starting row for report
    k = 7
'Put the data into report format
    For i = 1 To hdg1 'counter for each group heading
        Cells(k, 1).Value = hdg(i)
        Cells(k, 4).Value = "Start"
        Cells(k, 5).Value = "Maturity"
        Cells(k, 6).Value = "Face Value"
        Cells(k, 7).Value = "Amortization"
        Cells(k, 8).Value = "Book Value"
        Cells(k, 9).Value = "Yield"
        Cells(k, 10).Value = "Bond Rating"
        l = k 'Counter for top row of group
            For j = 1 To UBound(grp1) 'search array for data that matches heading
                If grp1(j) = hdg(i) Then
                        k = k + 1
                        Cells(k, 2).Value = grp2(j)
                        Cells(k, 3).Value = grp3(j)
                        Cells(k, 4).Value = grp4(j)
                        Cells(k, 5).Value = grp5(j)
                        Cells(k, 6).Value = grp6(j)
                        Cells(k, 7).Value = grp7(j)
                        Cells(k, 8).Value = grp8(j)
                        Cells(k, 9).Value = grp9(j)
                        Cells(k, 10).Value = grp10(j)
                End If
            Next j
        'Insert Totals
            k = k + 2
            l = k - l - 1
                Cells(k, 1).Value = hdg(i) & " Total"
                Cells(k, 6).FormulaR1C1 = "=SUBTOTAL(9,R[-" & l & "]C:R[-1]C)"
                Cells(k, 7).FormulaR1C1 = "=SUBTOTAL(9,R[-" & l & "]C:R[-1]C)"
                Cells(k, 8).FormulaR1C1 = "=SUBTOTAL(9,R[-" & l & "]C:R[-1]C)"
                Cells(k, 9).FormulaR1C1 = "=sumproduct(--(R[-" & l & "]C[-3]:R[-1]C[-3]),--(R[-" & l & "]C:R[-1]C))/RC[-3]"
                
        'Format display
                With Union(Range(Cells(k, 1), Cells(k, 10)), Range(Cells(k - l - 1, 1), Cells(k - l - 1, 10)))
                    .Font.Bold = True
                    With .Borders(xlEdgeTop)
                        .LineStyle = xlContinuous
                        .Weight = xlThin
                        .ColorIndex = xlAutomatic
                    End With
                    With .Borders(xlEdgeBottom)
                        .LineStyle = xlContinuous
                        .Weight = xlThin
                        .ColorIndex = xlAutomatic
                    End With
                End With
          'Put two blank rows in between
            k = k + 3
        Next i

'Finish Formatting - make it look pretty
    Range("F:H").NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""??_);_(@_)"
    Range("I:I").NumberFormat = "0.00%"
    Columns.AutoFit
    Columns("A:A").ColumnWidth = 4
    Range("A1").Value = CUname
    Range("A2").Value = "Board Report on Investment Management"
    Range("A3").Value = "Part 4 - Investment Quality"
    Range("A4").Value = RPdate
        With Range("A1:J4")
            .HorizontalAlignment = xlCenterAcrossSelection
            .Font.Bold = True
        End With


ActiveWindow.DisplayGridlines = False
Application.ScreenUpdating = True
End Sub

Hi

I wish to lock multiple selections within a model which is contained within a worksheet i also want all cells outside the model to be locked. so basically there will be more things locked than not.

i can lock cells the normal way using but this only gives me one chance to lock everything i have a lot to work through and i am bound to miss something but i dont want to start all over again.

any one got any tips

Regards

I have a spreadsheet (attached) that tracks sales of my songs for sale.

I have set up a totals sheet and wish to count various instances. my first field being C3 on Totals sheet. I want that to check each sheet and return the no of times that a particular song is listed with an extra proviso, in this case, that the song was downloaded in "EUR" currency and that the song name is "Touching Things Is Fun (the Winky Song)".

Now for that particular search, it should return a value of 8 for sheet (Mar2010sales). fields B2 and B4 added together.

What formula could do that for me ? - I am having trouble finding one and if I have found something that may do it, I don't understand it.

Any help much appreciated.