Posts by nilem
-
-
Hi Rakesh,
try thisCode
Display More'....... For Each currentCell In targetRange If InStr(1, LCase$(currentCell), "mr ", vbBinaryCompare) > 0 And _ InStr(1, LCase$(currentCell), "mrs ", vbBinaryCompare) > 0 Then currentCell.Offset(, salutationColumn - 1) = "Dear Sir/Madame" currentCell.Offset(, commentColumn - 1) = "Banking Facilities" ElseIf InStr(1, LCase$(currentCell), "mrs ", vbBinaryCompare) > 0 Then currentCell.Offset(, salutationColumn - 1) = "Dear Madame" currentCell.Offset(, commentColumn - 1) = "Banking Facility" ''''''''''''''''added begin ''''''''''' ElseIf LCase$(currentCell) Like "*mr*mr*" Then currentCell.Offset(, salutationColumn - 1) = "Dear Messrs" currentCell.Offset(, commentColumn - 1) = "Banking Facilities" ''''''''''''added end ''''''''''''''''''' ElseIf InStr(1, LCase$(currentCell), "mr ", vbBinaryCompare) > 0 Then currentCell.Offset(, salutationColumn - 1) = "Dear Sir" currentCell.Offset(, commentColumn - 1) = "Banking Facility" ElseIf InStr(1, LCase$(currentCell), "miss ", vbBinaryCompare) > 0 Then currentCell.Offset(, salutationColumn - 1) = "Dear Miss" currentCell.Offset(, commentColumn - 1) = "Banking Facility" End If Next currentCell '.......
-
-
Try this (in sheet module)
Code
Display MoreOption Explicit Dim r As Range Private Sub Worksheet_Activate() Set r = ActiveCell End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.CountLarge > 1 Then Exit Sub With r .Interior.ColorIndex = xlNone .Formula = LCase$(.Formula) .Font.Bold = False End With With Target .Interior.Color = vbCyan .Formula = UCase$(.Formula) .Font.Bold = True End With Set r = Target End Sub
-
Hi Eureka18,
Obviously, there is an error in the UserForm_Initialize procedure. Open the UserForm module, fix the error, and everything will be fine. -
Of course, you are on a free forum. But you demand an answer, as if you are on a paid resource. That was my answer in a PM.
You should just wait until someone answers your question (I will no longer answer your questions).
PS nilem 'he', not 'she' ) -
Code
Display MoreSub ertert() Dim x, i&, nm2$, adr$ Dim r As Range, k& x = Sheets("Sheet1").Range("A1").CurrentRegion.Value With Sheets("Sheet2") For i = 2 To UBound(x) nm2 = x(i, 3): k = 3 Set r = .Columns(1).Find(nm2, LookIn:=xlValues, lookat:=xlWhole) If Not r Is Nothing Then adr = r.Address Do k = k + 1: [COLOR=#FF0000]If k > UBound(x, 2) Then Exit Do[/COLOR] .Cells(r.Row, Columns.Count).End(xlToLeft)(1, 2).Value = x(i, k) Set r = .Columns(1).FindNext(r) Loop While r.Address <> adr End If Next i End With End Sub
-
-
Hi agog1,
try thisCode
Display MoreSub ertert() Dim x, i&, nm2$, adr$ Dim r As Range, k& x = Sheets("Sheet1").Range("A1").CurrentRegion.Value With Sheets("Sheet2") For i = 2 To UBound(x) nm2 = x(i, 3): k = 3 Set r = .Columns(1).Find(nm2, LookIn:=xlValues, lookat:=xlWhole) If Not r Is Nothing Then adr = r.Address Do k = k + 1 .Cells(r.Row, Columns.Count).End(xlToLeft)(1, 2).Value = x(i, k) Set r = .Columns(1).FindNext(r) Loop While r.Address <> adr End If Next i End With End Sub
-
try this
Code
Display MoreDo Until Cells(RowNum, 4).Value = "" Select Case True Case Cells(RowNum, 4).Value Like "2ERWF*": Cells(RowNum, 5).Value = "WAFER" Case Cells(RowNum, 4).Value Like "SE*": Cells(RowNum, 5).Value = "PARTS" Case Cells(RowNum, 4).Value Like "SM*": Cells(RowNum, 5).Value = "BUSINESS SUPPORT" Case Cells(RowNum, 4).Value Like "CH-WT*": Cells(RowNum, 5).Value = "CHEMICAL" Case Else Cells(RowNum, 5).Value = "OTHER" End Select RowNum = RowNum + 1 Loop
-
This means that not all data are numbers. Please attach a sample file with your data.
-
-
Hi,
maybe so -
-
Hi jeanbot,
maybe soCode
Display MorePrivate Sub Worksheet_Change(ByVal Target As Range) selectedNa = Target.Value Select Case Target.Column Case 6 selectedNum = Application.VLookup(selectedNa, Worksheets("Look Up").Range("F_Product_Type"), 2, False) If Not IsError(selectedNum) Then Application.EnableEvents = False Target.Value = selectedNum Application.EnableEvents = True End If Case 7 selectedNum = Application.VLookup(selectedNa, Worksheets("Look Up").Range("F_Material_Type"), 2, False) If Not IsError(selectedNum) Then Application.EnableEvents = False Target.Value = selectedNum Application.EnableEvents = True End If Case Else Exit Sub End Select End Sub
-
Hi Pvman,
maybe soCode
Display MoreSub ertert() Dim SourceRng As Range, DestRng As Range, i& On Error Resume Next Set SourceRng = Application.InputBox("Select SourceRng", Type:=8) If SourceRng Is Nothing Then Exit Sub Set DestRng = Application.InputBox("Select top left cell of the DestRng", Type:=8) If DestRng Is Nothing Then Exit Sub On Error GoTo 0 For i = 1 To SourceRng.Count If SourceRng(i, 1) < 50 Then DestRng(i, 1) = SourceRng(i, 1) * 2 Else DestRng(i, 1) = 0 End If Next i End Sub
-
Hi HowHow,
try thisCode
Display MoreSub ByeForA() Dim x, y(), Weeks, i&, j&, k& x = Range("H2:X19").Value ReDim y(1 To UBound(x) + 1, 1 To UBound(x, 2)) Weeks = Range("H22:X22").Value For j = 1 To UBound(Weeks, 2) If Len(Weeks(1, j)) Then k = 0 For i = 1 To UBound(x) k = k + 1 If i = Weeks(1, j) Then y(k, j) = "Bye" k = k + 1: y(k, j) = x(i, j) Else y(k, j) = x(i, j) End If Next i End If Next j Range("H2:X20").Value = y End Sub
-
On all sheets are always 3 Sub_Product_Groups, and 3 Customer_SubGroups, right?
-
Hi
try thisCode
Display MoreSub ertert() Dim x, i&, j&, k&, s$, Vrsn With Range("A1").CurrentRegion x = .Value For i = 1 To UBound(x, 1) If s = x(i, 1) Then If x(i, 7) > Vrsn Then For j = 1 To UBound(x, 2) x(k, j) = x(i, j) Next j End If Else s = x(i, 1): Vrsn = x(i, 7): k = k + 1 For j = 1 To UBound(x, 2) x(k, j) = x(i, j) Next j End If Next i .ClearContents .Resize(k).Value = x End With End Sub
-
Please attach an example of your file