may be this macro can you help (the selection method Not necessary)
Option Explicit
Sub test()
With Sheets("general.switchboard")
.Range("R57:AR155").ClearContents
.Range("AF51") = "OK" '====>>> Change as you like
End With
End Sub
change the two lines in my code
For i = 4 To Cells(Rows.Count, 1).End(3).Row
If i Mod 4 <> 0 Then
To
For i = 1 To Cells(Rows.Count, 1).End(3).Row
If i Mod 6 <> 0 Then
Try this macro
Option Explicit
Sub del_rows()
Dim i%
Dim MY_RG As Range
For i = 4 To Cells(Rows.Count, 1).End(3).Row
If i Mod 4 <> 0 Then
If MY_RG Is Nothing Then
Set MY_RG = Range("a" & i)
Else
Set MY_RG = Union(MY_RG, Range("a" & i))
End...
Try this macro
Option Explicit
Sub Extract_Please()
Dim n As Long
Dim rgx As Object
Dim My_NUm As Object
Dim ws As Worksheet
Dim lrd%, I%
Set rgx = CreateObject("VBScript.RegExp")
Set ws = Worksheets("Sheet1")
lrd = ws.Cells(Rows.Count, "D").End(3).Row...
Try my Macro
Option Explicit
Sub Extract()
Rem====>>Created by Salim Hasan on 30/9/2019
Dim i%, m%, D As Object, col As Object
Dim ky, st
Dim k%: k = 1
Dim LRB%: LRB = Cells(Rows.Count, 2).End(3).Row
Union(Range("D6", Range("D5").End(4)), _
Range("F6", Range("F5").End(4))).ClearContents
Set D...
Try this macro
Option Explicit
Sub data_val()
Dim My_list As Object
Dim Rg As Range, CL As Range
Set Rg = Range("C3", Range("c2").End(4))
Set My_list = CreateObject("System.Collections.ArrayList")
With My_list
For Each CL In Rg
If Not .Contains(CL.Value) Then .Add CL.Value
Next
End...
Try this macro
(without for next loop)
(without copy and paste)
Option Explicit
Sub Salim_Macro()
Sheet2.[A1].CurrentRegion.ClearContents
Dim Range_To_Copy As Range
Set Range_To_Copy = Sheet1.[A1].CurrentRegion
Dim Max_ro: Max_ro = Range_To_Copy.Rows.Count
Dim Max_col: Max_col =...
Can you Try this Macro??
Option Explicit
Sub EXTRACT_NUM()
Dim r%: r = Cells(Rows.Count, 1).End(3).Row
Dim i%, Oui
Range("B2").Resize(r - 1).ClearContents
Dim Obj As Object
Set Obj = CreateObject("VBscript.regExp")
Obj.Pattern = "(\d{4})"
For i = 2 To r
If Obj.test(Range("a" & i)) Then
Set...
try this macro
Option Explicit
Sub BORDER_IT()
With Range("a1").CurrentRegion
.Borders.LineStyle = 0
With .Columns(1).SpecialCells(2, 23)
.Borders.LineStyle = 1
.Offset(, 1).Borders.LineStyle = 1
End With
End With
End Sub
Try Please This Macro
Sub Give_data()
Dim SH1 As Worksheet: Set SH1 = Sheets("Sheet1")
Dim SH2 As Worksheet: Set SH2 = Sheets("Sheet2")
SH2.Range("A1").CurrentRegion.Offset(1).ClearContents
Dim source_range As Range
Dim my_rg As Range
Dim Em_name$, mY_st1$, cont%, s#, m%: m = 2
Dim i%, K%...
Hi my Friend Yasser
Can you please try My Macro
Option Explicit
Sub Tajriba()
Dim Mon_Array, s
Dim x%: x = 10
s = "Row( 1:" & x & ")"
Mon_Array = Application.Transpose(Evaluate(s))
Range("A1").Resize(x) = Application.Transpose(Mon_Array)
End Sub
Rem Something else might have been useful...
Suppose you data in celll A1
Try this formula
Note : Array Formula (Ctrl+Shit +Enter)
=IF(A1="","",SUMPRODUCT(IF(MID(TRIM(A1),ROW(INDIRECT("1:"&LEN(TRIM(A1)))),1)=".",1,0)))
1-First of all your two workbooks must be saved in the Same Folder
2- active workbook is AP.xls
3- run this macro
Option Explicit
Sub copy_To_SEC_BOOK()
Dim wbk1 As Workbook, wsh1 As Worksheet
Dim wbk2 As Workbook, wsh2 As Worksheet
Set wbk1 = ThisWorkbook: Set wsh1 = wbk1.Worksheets(1)...