Posts by nyatiaju

nyatiaju · Jul 3rd 2019

It's just value of result cell. If you place formula in Z1, then it should be sheets("Production data").range(sheets("Production data").range("Z1").value).select

nyatiaju · Jul 3rd 2019

Replace R1 with Line number value. 1.2,3,etc.

Quote

=ADDRESS(MATCH(R1,$N$2:$N$500,1)+1,14)

nyatiaju · Jul 3rd 2019

see attached

nyatiaju · Jul 2nd 2019

As per your note above, If machine sheet does not exist skip the row.

Code

Sub CopyData()
Dim wsPro As Worksheet, ws As Worksheet
Dim ProMachine As String, PreProMachine As String
Dim i As Long, lrow As Long
Dim data(0, 0 To 3) As Variant
Dim Machine As String


Set wsPro = ThisWorkbook.Sheets("Production Data")
lrow = wsPro.Range("A" & Rows.Count).End(xlUp).Row


For i = 2 To lrow
    PreProMachine = wsPro.Range("B" & i - 1) & wsPro.Range("N" & i - 1)
    ProMachine = wsPro.Range("B" & i) & wsPro.Range("N" & i)
    If ProMachine <> PreProMachine Then
        Machine = "Machine " & wsPro.Range("N" & i)
        Set ws = MachineSheet(Machine)
        If ws Is Nothing Then GoTo NextRow
        data(0, 0) = wsPro.Range("B" & i)
        data(0, 1) = wsPro.Range("C" & i)
        data(0, 2) = wsPro.Range("E" & i)
        data(0, 3) = wsPro.Range("N" & i)
        eRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row + 1
        ws.Range("A" & eRow & ":D" & eRow) = data
    End If
NextRow:
Next i


End Sub




Function MachineSheet(Machine As String) As Worksheet
Dim ws As Worksheet


For Each ws In ThisWorkbook.Sheets
    If ws.Name = Machine Then
        Set MachineSheet = ws
        Exit For
    End If
Next ws


'If MachineSheet Is Nothing Then
'    Set MachineSheet = ThisWorkbook.Sheets.Add(after:=ThisWorkbook.Sheets.Count)
'    MachineSheet.Name = Machine
'End If


End Function

Display More

nyatiaju · Jul 1st 2019

For which line you get this message

Quote

Compile Error in Hidden Module: Sheet2

. Compile project on user system in Debug Menu>Compile VBA project

nyatiaju · Jul 1st 2019

Code

Sub CopyData()
Dim wsPro As Worksheet, ws As Worksheet
Dim ProMachine As String, PreProMachine As String
Dim i As Long, lrow As Long
Dim data(0, 0 To 3) As Variant
Dim Machine As String


Set wsPro = ThisWorkbook.Sheets("Production Data")
lrow = wsPro.Range("A" & Rows.Count).End(xlUp).Row


For i = 2 To lrow
    PreProMachine = wsPro.Range("B" & i - 1) & wsPro.Range("N" & i - 1)
    ProMachine = wsPro.Range("B" & i) & wsPro.Range("N" & i)
    If ProMachine <> PreProMachine Then
        Machine = "Machine " & wsPro.Range("N" & i)
        Set ws = MachineSheet(Machine)
        data(0, 0) = wsPro.Range("B" & i)
        data(0, 1) = wsPro.Range("C" & i)
        data(0, 2) = wsPro.Range("E" & i)
        data(0, 3) = wsPro.Range("N" & i)
        eRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row + 1
        ws.Range("A" & eRow & ":D" & eRow) = data
    End If
                  
Next i


End Sub




Function MachineSheet(Machine As String) As Worksheet
Dim ws As Worksheet


For Each ws In ThisWorkbook.Sheets
    If ws.Name = Machine Then
        Set MachineSheet = ws
        Exit For
    End If
Next ws


If MachineSheet Is Nothing Then
    Set MachineSheet = ThisWorkbook.Sheets.Add(after:=ThisWorkbook.Sheets.Count)
    MachineSheet.Name = Machine
End If


End Function

Display More

nyatiaju · Jun 28th 2019

This works:

Code

ActiveSheet.Range("MyRange1").value = ""


ActiveSheet.Range("MyRange1").value = "This shall be written in the range."

nyatiaju · Jun 28th 2019

I see that numbers are written continuously. Place strings in A column and results in B:E column.

Try below:

Code

Sub TestString()
Dim rg As Range


For Each rg In Range("A1:A100")
    If rg <> "" Then Range(rg.Offset(, 1), rg.Offset(, 4)) = GetValue(rg.value)
Next rg
End Sub


Function GetValue(value As String) As Variant
Dim n(1 To 4) As Long
Dim i As Integer, j As Integer


j = 1
For i = 1 To Len(value)
    If IsNumeric(Mid(value, i, 1)) Then
        n(j) = Mid(value, i, 5)
        i = i + 5
        j = j + 1
    End If
Next i


GetValue = n


End Function

Display More

nyatiaju · Jun 28th 2019

Please upload input file & output snapshot

nyatiaju · Jun 28th 2019

Change sheet reference to your need and run it. Consider outlook is already open.

HTML

Sub TestOL()
Dim ol As Object
Dim str As String, tblStr As String, ClsStr As String
Dim mi As Object


Set ol = GetObject(, "outlook.application")


tblStr = "<html><body><br><table border=""1"" border-color: gray>"


ClsStr = "</table><br></body></html>" & vbNewLine & vbNewLine & vbNewLine & "Thank you,"


For i = 3 To 4
    Set mi = CreateItem(olMailItem)
    If i = 3 Then
        str = "Hi All," & vbNewLine & vbNewLine & "Following staff were absent 3 times:" & vbNewLine & tblStr & GetRow & ClsStr
       
    Else
        str = "Hi All," & vbNewLine & vbNewLine & "Following staff were absent 4 times and above:" & vbNewLine & tblStr & GetRow(True) & ClsStr
    End If
   
    With mi
        .Subject = "Test"
        .HTMLBody = str
        .Display
    End With
Next i


End Sub


Function GetRow(Optional Greater3 As Boolean = False) As String
Dim rg As Range
Dim str As String
Dim lRow As Long


str = "<tr><td>Name</td><td>No of Absents</td>"
lRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row


For Each rg In ActiveSheet.Range("B2:B" & lRow)
    If Not Greater3 And rg = 3 Then
            str = str & vbNewLine & "<tr><td>" & rg.Offset(0, -1) & "</td><td>" & rg & "</td>"
    ElseIf Greater3 And rg > 3 Then
            str = str & vbNewLine & "<tr><td>" & rg.Offset(0, -1) & "</td><td>" & rg & "</td>"
   
    End If
Next rg


GetRow = str


End Function

Display More

nyatiaju · Jun 26th 2019

Try below code:

Code

Sub Testwd()
Dim wd As Object
Dim doc As Object


Set wd = GetObject(, "word.application")
Set doc = wd.ActiveDocument


doc.Bookmarks("FirstBookMark").Range.Text = Range("A1").Value
doc.Bookmarks("SecondBookMark").Range.Text = Range("A2").Value


End Sub

Display More

nyatiaju · Jun 26th 2019

Try this:

Code

Sub Test()
Dim shp As Shape
Dim sht As Worksheet


For Each sht In ThisWorkbook.Sheets
    For Each shp In sht.Shapes
        If shp.Type = msoTextBox Then shp.TextFrame.AutoSize = True
    Next shp
Next sht


End Sub

Display More

nyatiaju · Jun 25th 2019

Place your data in A column and run below code.

Code

Sub Test()
Dim rg As Range, i As Long


i = 1
For Each rg In Range("A2:A1000")
    If rg <> rg.Offset(-1, 0) Then
        Range("B" & i) = rg
        i = i + 1
    End If
       
Next rg


End Sub

Display More

nyatiaju · Jun 25th 2019

You should use database to store raw data of example file.

nyatiaju · Apr 5th 2019

You will need 2 macros to achieve it.

Code

Private Sub Workbook_Open()
    Application.OnTime Now + TimeValue("0:19:0"), "MyMac1"
    Application.OnTime Now + TimeValue("0:20:0"), "MyMac2"
End Sub


Sub MyMac1()


MsgBox "you have 1 min left. Session will be closed."




End Sub


Sub MyMac2()


ThisWorkbook.Close savechanges:=True
End Sub

Display More

nyatiaju · Mar 24th 2018

Hi, I have updated File to check duplicate dates per name and missing entries.

nyatiaju · Mar 18th 2018

See attachment for reference.

nyatiaju · Mar 18th 2018

Place this code in module and call it from any cell like formula.

Quote

=GMT(A1)

===================================================

Code

Function GMT(CentralTime As Variant) As Variant
Dim off As Variant


If InStr(UCase(CentralTime), "OFF") Then
    off = Split(CentralTime, " ")
    GMT = Month(off(0)) & "/" & Day(off(0)) & "/" & Year(off(0)) & " Off"
    
Else
    If Hour(CentralTime) >= 10 Then
        GMT_Date = Month(CentralTime) & "/" & Day(CentralTime) + 1 & "/" & Year(CentralTime)
        GMT_Hour = Format((Hour(CentralTime) + 14) Mod 24 & ":" & Minute(CentralTime) & ":" & Second(CentralTime), "hh:nn:ss")
    Else
    
        GMT_Date = Month(CentralTime) & "/" & Day(CentralTime) & "/" & Year(CentralTime)
        GMT_Hour = Format(Hour(CentralTime) + 14 & ":" & Minute(CentralTime) & ":" & Second(CentralTime), "hh:nn:ss")
    End If
    
    GMT = GMT_Date & " " & GMT_Hour
End If
End Function

Display More

nyatiaju · Feb 13th 2018

See attached as per requirement. Select Name and License, date is filled in Date text box. Change the date, Click on Update to send it back to Excel sheet.

nyatiaju · Jan 22nd 2018

Code

Public Sub FalseDataset()
   
    Dim DS  As Variant
    Dim lrow As Long
   
    lrow = Range("A" & Rows.Count).End(xlUp).Row
    DS = Range("A1:B" & lrow).Value


    Dim i As Long
    For i = LBound(DS) To UBound(DS)
        If DS(i, 2) = "X" Then DS(i, 2) = ""
        '...
    Next i


    Range("A1:B" & lrow).Value = DS


End Sub

Display More

Posts by nyatiaju

Filter at every change in field

Filter at every change in field

Filter at every change in field

Filter at every change in field

Overcome Compile Error using Late Binding

Filter at every change in field

Error message when refering to a named Range

Can VBA grab multiple integers from a string?

Filter at every change in field

Automatically send email based on certain criteria from excel information

Copy text from a cell to a bookmark in Word

Select only the textboxes from all tabs within a worksheet

Filter at every change in field

Using a form to insert information

Countdown start upon opening of Workbook - close after 20 minutes

conversion of schedule to another timezone

conversion of schedule to another timezone

conversion of schedule to another timezone

UserForm with a ComboBox for Row and another for Column

Clear the content of false data sets