lionheart

Private Sub Worksheet_Activate() Dim e, ws As Worksheet For Each ws In ThisWorkbook.Worksheets If ws.Name <> Me.Name Then ws.Visible = xlSheetVeryHidden End If Next ws For Each e In Array("1", "2") Worksheets(e).Visible = xlSheetVisible Next e End Sub

Right-click worksheet name and select View Code and paste the code I posted Back to the worksheet, type any month number (say 10) in cell S2 and press Enter key

In worksheet module put the following code (but it is better to depend on another cell in the first two columns a way from S2) Private Sub Worksheet_Change(ByVal Target As Range) Dim myMonth, c As Long If Target.Address = "$S$2" Then Application.ScreenUpdating = False myMonth = Target.Value Columns("C:KX").Hidden = True For c = 3 To 310 With Cells(5, c) If .Value2 <> "" And Month(.Value2) = myMonth Then .EntireColumn.Hidden = False End If End With Next c Application.ScreenUpdating = True End If End Sub

So simple question. Just loop through the columns and check for the month of the date and hide those columns that don't have the same month

You are allowed to type yes or no only

How to execute code without code? and for what purpose you don't need to keep the code inside the file itself

The scroll button is linked to specific cell. Change the properties of that cell to make it unprotected Right-Click the cell and format cells and from Protection tab uncheck the option of Locked

The request is weird a little and using data validation list is better than using the code in worksheet module Generally here's the code (In Worksheet Module) Private Sub Worksheet_Change(ByVal Target As Range) Call Worksheet_SelectionChange(Target) End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) With Target If .Cells.CountLarge > 1 Then Exit Sub If .Row > 1 And .Column = 2 Then If LCase(.Value) = "yes" Or LCase(.Value) = "no" Then Application.EnableEvents = False .Value = StrConv(.Value, vbProperCase) .Font.ColorIndex = xlAutomatic Application.EnableEvents = True Exit Sub Else Application.EnableEvents = False .Value = Empty Application.EnableEvents = True End If If .Value = "" And .Offset(, -1).Value <> "" Then Application.EnableEvents = False .Value = "Type 'Yes' to accept - Type 'No' to reject" With .Font .Name = "Calibri" .FontStyle = "Regular" .Size = 9 .Color = RGB(217, 217, 217) End With Application.EnableEvents = True End If End If End With End Sub

Sub Test() Dim ws As Worksheet, sh As Worksheet, lr As Long, lc As Long, r As Long, c As Long, m As Long Application.ScreenUpdating = False Set ws = ThisWorkbook.Worksheets(1) Set sh = ThisWorkbook.Worksheets(2) sh.Range("B7:C100").ClearContents lr = LastRow(ws) lc = LastCol(ws) m = 7 For r = 4 To lr Step 2 For c = 1 To lc If ws.Cells(r + 1, c).Value <> "" Then sh.Cells(m, 2).Value = ws.Cells(r, c).Value sh.Cells(m, 3).Value = ws.Cells(r + 1, c).Value m = m + 1 End If Next c Next r Application.ScreenUpdating = True MsgBox "Done", 64 End Sub Function LastRow(sh As Worksheet) On Error Resume Next LastRow = sh.Cells.Find(What:="*", After:=sh.Range("A1"), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row On Error GoTo 0 End Function Function LastCol(sh As Worksheet) On Error Resume Next LastCol = sh.Cells.Find(What:="*", After:=sh.Range("A1"), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False).Column On Error GoTo 0 End Function

It seems links are forbidden here in this forum (and that is too weird) remove spaces in the following line https: // excel-egy . com / forum/ t2823

Here's a file with 3000 rows File.xlsm

Can you attach the file that has 3000 rows? It is supposed not so big number of rows

Try the code with large amount of data and tell us the final result and the time that will the code take

Just change the range in this line to suit your needs Range("A2", Range("A" & Rows.Count).End(xlUp))

Use IFERROR function

You are asking for a complete program not for a solution of a specific problem so I think you will not find any help Be specific and ask for the solution of only one problem and explain it well

To implement .. With your workbook active press Alt+F11 to bring up the vba window. In the Visual Basic window use the menu to Insert|Module Copy and Paste the code below into the main right hand pane that opens at step 2. Close the Visual Basic window. Press Alt+F8 to bring up the Macro dialog Select the macro & click ‘Run’ Your workbook will need to be saved as a macro-enabled workbook (*.xlsm) Don't forget to remove the conditional formatting from the worksheet

I think the link on excel-egy on this topic t2823 will be useful for you

You didn't explain the problem well. Please be sepcific and put the desired output as an image if you wait more help Private Sub btnOk_Click() Dim x As Control, s As String, r As Long Range("H1:H30").Clear For Each x In UserForm2.Controls If TypeName(x) = "CheckBox" Then If x.Value = True Then r = r + 1 s = s & IIf(s = vbNullString, vbNullString, vbLf) & x.Name Cells(r + 4, "H").Value = x.Caption End If End If Next x Range("H4").Value = r End Sub

I have no idea. Attach your file

Sub Test() Dim w, d As Object, r As Range Set d = CreateObject("Scripting.Dictionary") d.CompareMode = 1 With Range("A2", Range("A" & Rows.Count).End(xlUp)) .Interior.colorIndex = xlNone For Each r In .Cells If Not d.Exists(r.Value) Then ReDim w(1 To 2) Set w(1) = r With Application.WorksheetFunction w(2) = Array(.RandBetween(0, 255), .RandBetween(0, 255), .RandBetween(0, 255)) End With d(r.Value) = w Else w = d(r.Value) r.Interior.Color = RGB(w(2)(0), w(2)(1), w(2)(2)) If Not IsEmpty(d(r.Value)(1)) Then d(r.Value)(1).Interior.Color = RGB(w(2)(0), w(2)(1), w(2)(2)) w(1) = Empty d(r.Value) = w End If Next r End With End Sub

You can use helper columns A & B to achieve what you need by formulas مباريات.xlsx

After this line s = s & IIf(s = vbNullString, vbNullString, vbLf) & x.Name refer to the desire target cell by using the r variable like that Cells(r + 4, "H").Value = x.Name

No attachment, no code so no help

Use CHAR(10) instead of the space