Sub CollateData() Dim ws As Worksheet For Each ws In ThisWorkbook.Worksheets Set sht = Worksheets("AnalysisDump") With sht.Cells .ClearContents End With If ws.Name <> "mainmenu" And ws.Name <> "foldernamedump" And ws.Name <> "AnalysisDump" Then With ws .Range("A1:A2").Copy Sheets("AnalysisDump").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues .Range("C1:C2").Copy Sheets("AnalysisDump").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues End With End If Next ws Application.CutCopyMode = False End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range) Me.ScrollArea = "A1:F132" End Sub Private Sub ComboBox1_Change() End Sub Private Sub commandbutton1_click() checkvragen foto foto2 Macro2 Mail_workbook_Outlook_1 End Subthe module (sub) 'checkvragen' has this code:
Option Explicit Sub checkvragen() Dim rRange As Range Dim oCell As Variant Dim Counter As Long Dim Cancel As Integer Counter = 0 Set rRange = Sheets("Controlevelden").Range("B2:B21") For Each oCell In rRange If oCell.Value = 0 Then Counter = Counter + 1 End If Next If Counter <> 0 Then MsgBox "U heeft " & Counter & " vraag/vragen nog niet beantwoord." Else: MsgBox "U heeft alle vragen beantwoord." Cancel = True End If End SubCan anyone help me please?
VB: Dim c As Range For Each c In ActiveSheet.UsedRange If c.Interior.ColorIndex = xlNone Then c.ClearContents Next c If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
VB: Sheets(CurrMonth).Copy Before:=Sheets(CurrMonth) If you like these VB formatting tags please consider sponsoring the author in support of injured Royal MarinesAt that point i'm not sure what it does.. I Can't seem to step futher into that line, and so it looks like it just resets/restarts the macro. My problem is that I can't get past this line, and so the macro never finishes it's job. The purpose of the macro is to copy the current sheet, and then sort the copy by the worker field, and rename the copy as something like "JAN 2006 By Tech". Here is the first page or so of code:
VB: Sub Button3_Click() Dim TotalMerch Dim TotalComm Dim TotalNet Dim Year As String Dim Month As String TotalMerch = Application.Sum(Columns(7)) TotalComm = Application.Sum(Columns(8)) TotalNet = Application.Sum(Columns(10)) Dim CurrMonth As String CurrMonth = ActiveSheet.Name 'Current Month should be active sheet name Dim Temp Temp = CurrMonth + "~" 'Temporary name of temporary sheet Sheets(CurrMonth).Copy Before:=Sheets(CurrMonth) 'Copies active sheet, moves before Template Sheets(CurrMonth + " (2)").Name = Temp 'Renames active sheet Dim wSht As Worksheet Dim shtName As String shtName = CurrMonth + " by Tech" ' e.g. June '03 by Tech Sheets(Sheets.Count).Copy after:=Sheets(CurrMonth) ' Copy template and move to end Sheets("Template (2)").Name = shtName Sheets(Temp).Range("A4:K500").Sort _ Key1:=Sheets(Temp).Columns(4), Order1:=xlAscending, _ Key2:=Sheets(Temp).Columns(3), Order2:=xlAscending 'Sorts temporary sheet Dim LastRow LastRow = Sheets(Temp).Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row 'Finds last row used TechName = UCase(Sheets(Temp).Cells(4, 4)) CurrRow = 2 ' Starts importing into first available row Start = 2 Skip = 36 If you like these VB formatting tags please consider sponsoring the author in support of injured Royal MarinesAny help is appreciated! I can't figure out what's going on... the code looks like it is supposed to as far as I know, but it's been a while since I've done much VB scripting.
Sub SummarySheets() Dim ws As Worksheet MySheets = Array("Header", "RAG", "Summary by Period", "Vol Totals ") Call Hide_Show(MySheets) End Sub Function Hide_Show(MySheets) Application.ScreenUpdating = False For Each ws In Sheets X = Application.Match(ws.Name, MySheets, 0) If Not IsError(X) Then ws.Visible = True Else ws.Visible = False End If Next ws Application.ScreenUpdating = True End FunctionThe error occurs on the "ws.Visible = False" line.
Sub ClearWDRow1() ' ' ClearWDRow1 Macro ' Macro recorded 6/25/2009 by Jim Ogier Thanks Jim O ' ' Range("B19:T19").Select Selection.Clear End Sub